通过VBA从Excel发送电子邮件附件

Question

我写了一个宏,只需点击一下按钮就可以通过Outlook发送自动发送的电子邮件.一切都运行顺利,除了我无法弄清楚如何将文件附加到电子邮件.在我看过的每个地方,将文件附加到电子邮件的示例代码都是针对静态命名文件的,例如,您发送的文件名相同,每次都使用相同的路径.

如果它更方便,运行此宏的按钮位于我正在尝试附加的工作簿中.我不确定打开Windows资源管理器窗口是否最简单,并且以这种方式附加文件是最好的.

Sub mySub
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim WeekendingDate As Date

    With Worksheets("Macro Buttons")
        WeekendingDate = Range("N2").Value
    End With

    Set objOutlook = CreateObject("Outlook.Application")

    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

    With objOutlookMsg
        Set objOutlookRecip = .Recipients.Add("blah@blah")
        objOutlookRecip.Type = olTo
       .Subject = "Blah " & WeekendingDate
       .Body = "blah blah blah"

       'Add attachments to the message
       [some code]


       For Each objOutlookRecip In .Recipients
           objOutlookRecip.Resolve
       Next
       If DisplayMsg Then
           .Display
       Else
           .Save
       End If
    End With
    Set objOutlook = Nothing
End Sub

Answer 1

您需要Attachments.Add插入MailItem设置中的代码:

With objOutlookMsg
    Set objOutlookRecip = .Recipients.Add("blah@blah")
    objOutlookRecip.Type = olTo
   .Subject = "Blah " & WeekendingDate
   .Body = "blah blah blah"
'Add attachments to the message [some code]
   .Attachments.Add "pathToFile"
   For Each objOutlookRecip In .Recipients
       objOutlookRecip.Resolve
   Next
   If DisplayMsg Then
       .Display
   Else
       .Save
   End If
End With
Set objOutlook = Nothing

在我自己的一个脚本中,我使用Dictionary对象和以下代码将附件集合传递给要附加的MailItem:

With oMailItem
        Set .SendUsingAccount = oOutlook.Session.Accounts.Item(iAccount)
        .To = EmailData("To")
        .CC = EmailData("CC")
        .BCC = EmailData("BCC")
        .Subject = EmailData("Subject")
        .Body = EmailData("Body")
        sAttachArray = Split(EmailData("AttachmentPaths"), ";")
        For Each sAttachment In sAttachArray
            .Attachments.Add(sAttachment)
        Next
        .Recipients.ResolveAll
        .Display    ' debug mode - uncomment this to see email before it's sent out
    End With