修改电子邮件发送macros以包含附件

我想修改这个脚本在它创build的电子邮件中包含一个附件。 工作表“指令”中的单元格F5包含文件path。 我试图使用来自多个不同来源的信息进行修改。

这是一个工作版本，预附件尝试：

Sub CreateMails() Dim objOutlook As Object Dim objMail As Object Dim rngTo As Range Dim rngSubject As Range Dim rngBody As String Dim rngAttach As Range Dim SigString As String Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) With Worksheets("Data validation") Set rngTo = .Range("J63") Set rngSubject = .Range("J61") strbody = "One time vendor number request." & vbNewLine & vbNewLine & _ "Thank you," & vbNewLine & vbNewLine & _ "__________________________________" & vbNewLine & _ .Range("J67") & vbNewLine & vbNewLine & _ "My Company" & vbNewLine & _ "123 Address street" & vbNewLine & _ "City, State, Zip, USA" & vbNewLine & _ "Telephone:" End With With objMail .To = rngTo.Value .Subject = rngSubject.Value .Body = strbody .Save End With Set objOutlook = Nothing Set objMail = Nothing Set rngTo = Nothing Set rngSubject = Nothing Set strbody = Nothing Set rngAttach = Nothing End Sub 

Answer 1

所有你需要的是：

 With objMail .To = rngTo.Value .Subject = rngSubject.Value .Body = strbody .attachments.Add Range("F5").Value 'add the attachment .Save End With 

使用你的代码，这为我工作。

Answer 2

嗨，我可以共享下面的模板代码，我用来创build和附加从我的工作簿作为PDF表_我已经改变了一些“文本”值，但其余的是相同的。

你可以使用这个来包含附件，如果需要的话可以用xlsx发送。

 Sub SendWorkSheetToPDF() Dim Wb As Workbook Dim FileName As String Dim OutlookApp As Object Dim OutlookMail As Object Dim SH As Worksheet Dim cell As Range Dim strto As String Dim Strcc As String Application.ScreenUpdating = False 'To' For Each cell In ThisWorkbook.Sheets("Mail_addresses").Range("A2:A15") If cell.Value Like "?*@?*.?*" Then strto = strto & cell.Value & ";" End If Next cell If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1) On Error Resume Next 'CC' For Each cell In ThisWorkbook.Sheets("Mail_addresses").Range("B2:B15") If cell.Value Like "?*@?*.?*" Then Strcc = Strcc & cell.Value & ";" End If Next cell If Len(Strcc) > 0 Then Strcc = Left(Strcc, Len(Strcc) - 1) On Error Resume Next Set Wb = Application.ActiveWorkbook FileName = "afilename" xIndex = VBA.InStrRev(FileName, ".") If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex - 1) FileName = FileName & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) With OutlookMail .To = strto .CC = Strcc .BCC = "" .Subject = "subject text" .Body = "All," & vbNewLine & vbNewLine & _ "Please see attached daily " & vbNewLine & vbNewLine & _ "Kind Regards" & vbNewLine & _ " " .Attachments.Add FileName .Send End With Kill FileName Set OutlookMail = Nothing Set OutlookApp = Nothing MsgBox "Email Sent" End Sub