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

您需要在MailItem设置中插入Attachments.Add代码：

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

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

1 个答案: