包含名称与收件人姓名相匹配的附件

我有Excel中的代码发送电子邮件到收件人列表：

Sub SendEMail() Dim xEmail As String Dim xSubj As String Dim xMsg As String Dim xURL As String Dim i As Integer Dim k As Double Dim xCell As Range Dim xRg As Range Dim xTxt As String On Error Resume Next xTxt = ActiveWindow.RangeSelection.Address Set xRg = Application.InputBox("Please select the data range:", "Send emails to:", xTxt, , , , , 8) If xRg Is Nothing Then Exit Sub If xRg.Columns.Count <> 3 Then MsgBox "Incorrect number of columns: You have to choose Name, Email address, Account no.!" Exit Sub End If For i = 1 To xRg.Rows.Count ' Get the email address xEmail = xRg.Cells(i, 2) ' Message subject xSubj = "Your customer's account is on hold" ' Compose the message xMsg = "" xMsg = xMsg & "Dear client" & "," & vbCrLf & vbCrLf xMsg = xMsg & "We would like to inform you, that Your account has been put on hold - " xMsg = xMsg & xRg.Cells(i, 3).Text & "." & vbCrLf & vbCrLf xMsg = xMsg & "If you have any queries, please contact us on [e-mail]." & vbCrLf & vbCrLf xMsg = xMsg & "Kind regards," & vbCrLf xMsg = xMsg & "Jon and Martina" ' Replace spaces with %20 (hex) xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20") xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20") ' Replace carriage returns with %0D%0A (hex) xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf, "%0D%0A") ' Create the URL xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg ' Execute the URL (start the email client) ShellExecute 0&, vbNullString, xURL, vbNullString, vbNullString, vbNormalFocus ' Wait two seconds before sending keystrokes Application.Wait (Now + TimeValue("0:00:02")) Application.SendKeys "%s" Next End Sub 

我想添加variables附件。 它将是一个pdf文件，其名称将与客户的名字相同（放在A列中）。 基本上它应该在“S：\ All Team \ AX OTI \ test \”中查找“Name.pdf”

源表格如下所示：

Answer 1

请尝试使用下面的代码。

  xMsg = xMsg & "Dear client" & xRg.Cells(i, 1) & "," & vbCrLf & vbCrLf 'Added the client Name (optional) you can remove it xMsg = xMsg & "We would like to inform you, that Your account has been put on hold - " xMsg = xMsg & xRg.Cells(i, 3).Text & "." & vbCrLf & vbCrLf xMsg = xMsg & "If you have any queries, please contact us on [e-mail]." & vbCrLf & vbCrLf xMsg = xMsg & "Kind regards," & vbCrLf xMsg = xMsg & "Jon and Martina" & vbCrLf & vbCrLf 'Added two break point ' Replace spaces with %20 (hex) xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20") xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20") ' Replace carriage returns with %0D%0A (hex) xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf, "%0D%0A") ' Create the URL xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg &"&attachment=S:\All Team\AX OTI\test\" & Cells(i,1) & ".pdf" 'Changed to this ' Execute the URL (start the email client) ShellExecute 0&, vbNullString, xURL, vbNullString, vbNullString, vbNormalFocus ' Wait two seconds before sending keystrokes Application.Wait (Now + TimeValue("0:00:02")) Application.SendKeys "%s" 

Answer 2

基于@Vityata的build议，我已经检查了这个问题，并基于这个，我改变了代码。 它被testing和工作顺利 。 代码要容易得多，但工作完成了。

 Sub SendEmail() Dim Mail_Object, OutApp As Variant With ActiveSheet lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row 'list of recipients (email address) - it takes as many addresses as B column contains End With For i = 2 To lastrow Set Mail_Object = CreateObject("Outlook.Application") Set OutApp = Mail_Object.CreateItem(0) With OutApp .Subject = "Your customer's account is on hold" .Body = "Dear client" & "," & vbCrLf & vbCrLf & "We would like to inform you, that Your account has been put on hold." & vbCrLf & vbCrLf & "If you have any queries, please contact us on [e-mail]." & vbCrLf & vbCrLf & "Kind regards," & vbCrLf & "Jon and Martina" .To = Cells(i, 2).Value strLocation = "S:\All team\AX OTI\test\" & Cells(i, 1) & ".pdf" .Attachments.Add (strLocation) .display '.send End With Next i debugs: If Err.Description <> "" Then MsgBox Err.Description End Sub 

Answer 3

这里有一些非常好用的东西 – 用不同的文件名添加附件到Outlook

在你的情况下，只需复制代码，并确保在部分strLocation写入如下所示的内容：

 strLocation = "C:\Users\user\Desktop\" & Cells(i,2) & ".pdf" 

因此，你将能够绕过它。 一般来说，仔细看看提到的答案，这是一个很好的方法（恕我直言，比发送密钥好）。