将包含代码的 Excel 文件作为附件发送

Posted 2023-03-15

【中文标题】将包含代码的 Excel 文件作为附件发送

【英文标题】：Sending Excel file, that contains the code, as an attachment

【发布时间】：2016-09-15 02:47:58

【问题描述】：

我编写了通过 Outlook 发送电子邮件的 Excel VBA 代码。

在我看过的所有地方，将文件附加到电子邮件的示例代码都是针对静态命名文件的，例如，您每次都发送相同的文件名和相同的路径。

运行此宏的按钮位于我尝试附加的工作簿中。

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

【参考方案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

在我自己的一个脚本中，我将一组附件传递给 MailItem 以使用 Dictionary 对象和以下代码进行附加：

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

【讨论】：

对于“文件路径”我应该放什么，因为我的路径是动态的？文件名正在改变

您要添加什么文件作为附件？

一个excel文件。我单击的命令按钮位于我要附加的工作簿中。

在这种情况下，使用Application.ActiveWorkbook.FullName 将（最近保存的，因此您可能需要在附加之前添加ActiveWorkbook.Save 命令）当前文件添加到电子邮件：.Attachments.Add Application.ActiveWorkbook.FullName

没问题。如果它解决了您的问题，请用复选标记标记答案，以便其他人也可以轻松看到:)