Excel VBA 发送带有可变数量附件的电子邮件

Excel VBA 发送带有可变数量附件的电子邮件

我正在尝试编写一些 VBA 代码,该代码将打开 Outlook 并将某个文件夹中的所有 PDF 附加到电子邮件中。我知道如何对一个项目执行此操作,但由于我不知道该文件夹将包含多少个项目,所以我需要以某种方式附加文件夹中的所有 PDF。我按照另一个教程操作,但出现运行时错误 438 - 对象不支持此属性或方法。

编辑:错误出现在 .From 行,但发生在应用程序的每一行。

我仔细检查了一下,发现 Microsoft Outlook 16.0 对象库已安装并在项目中处于活动状态。我是否遗漏了什么非常明显的东西?

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim StrFile As String, StrPath As String

Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)

StrPath = "H:\Desktop\TEST_PDF\"

With OutLookMailItem
    .From "[email protected]"
    .To "[email protected]"
    .Subject "MACRO TEST"
    .Body "TEST MESSAGE"

    StrFile = Dir(StrPath & "*.*")

    Do While Len(StrFile) > 0
        .Attachments.Add StrPath & StrFile
        StrFile = Dir
    Loop

    .Display
End With

Set OutLookApp = Nothing
Set OutLookMailItem = Nothing

答案1

我找不到MailItem.From任何属性。除此之外,我不确定为什么你的 中有 0。CreateItem此外,你需要=在属性前面OutLookMailItem分配值(例如 .To = "[email protected]"是正确的形式)。

如果你想从不同的帐户发送电子邮件,你有两个选择,我知道;要么使用.SentOnBehalfOfName你的帐户应该有的属性“以许可方式发送”(看起来您正在尝试使用 Group Mail,因此这看起来像是一个选项)。或者您可以使用.SendUsingAccount属性(我认为这就是您的意思.From)。

惊人的隆·德·布鲁因他在自己的博客文章中解释了这些。我将其和一些评论包含在这里,以供将来在 SU 上参考。

如果您正在使用SendUsingAccount,您可能想要识别帐号并确保您可以使用以下宏访问它们(登录等);

Sub Which_Account_Number()
'Don't forget to add a reference to Outlook in the VBA editor
    Dim OutApp As Outlook.Application
    Dim i As Long

    Set OutApp = CreateObject("Outlook.Application")

    For i = 1 To OutApp.Session.Accounts.Count
        'I prefer using Debug.Print instead of MsgBox
        MsgBox OutApp.Session.Accounts.Item(i) & " : This is account number " & i
    Next i
End Sub

当您确定要使用哪个帐户后,您可以继续下一步,即发送电子邮件的实际过程。

Sub Mail_Change_Account()
'Only working in Office 2007 and higher
'Don't forget to set a reference to Outlook in the VBA editor
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim OutAccount As Outlook.Account
    Dim strbody As String, StrFile As String, StrPath As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    StrPath = "H:\Desktop\TEST_PDF\"
    StrFile = Dir(StrPath & "*.*")

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    'You can use the account number or as the actual account address
    'Here I'm Assuming that you have access to [email protected] account...
    'on the system you are running this macro
    '(We used account address but the syntax...
    'for using account number is below as a comment as well)
    'Set OutAccount = OutApp.Session.Accounts.Item(1)
     Set OutAccount = OutApp.Session.Accounts("[email protected]")

    'You may want to comment-out the line below first to see the errors explicitly for now
    On Error Resume Next

    With OutMail
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = "MACRO TEST"
        .Body = strbody
        .SendUsingAccount = OutAccount
        '.SentOnBehalfOfName = "[email protected]"

        Do While Len(StrFile) > 0
            .Attachments.Add StrPath & StrFile
            StrFile = Dir
        Loop

        .Display   'or use .Send
    End With

    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    Set OutAccount = Nothing
End Sub

相关内容