附加多个文件以通过电子邮件或整个目录(VBA)发送

时间:2014-10-03 17:58:22

标签: excel vba excel-vba outlook

我试图通过VBA和Outlook发送包含多个附件的电子邮件。

如果我指定一个附件/文件的路径,我可以使用的代码,如果我确切地知道它们是什么,我也可以添加多个附件,但我不会继续前进 - 会有不同的计数和文件名。

我希望使用通配符发送,如下面的示例所示,但我认为我需要使用指向目录的某种循环。

我已经四处寻找解决方案,但我还没有看到任何适用于我的具体情况的东西。

     Private Sub Command22_Click()
        Dim mess_body As String
        Dim appOutLook As Outlook.Application
        Dim MailOutLook As Outlook.MailItem
        Set appOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = appOutLook.CreateItem(olMailItem)

            Set appOutLook = CreateObject("Outlook.Application")
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
            With MailOutLook
            .BodyFormat = olFormatRichText
            .To = "test@test.org"
            .Subject = "test"
            .HTMLBody = "test"
            .Attachments.Add ("H:\test\Adj*.pdf")
            '.DeleteAfterSubmit = True
            .Send
            End With
            MsgBox "Reports have been sent", vbOKOnly
       End Sub

1 个答案:

答案 0 :(得分:11)

这是你在尝试什么? (UNTESTED)

Private Sub Command22_Click()
    Dim mess_body As String, StrFile As String, StrPath As String
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem

    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)

    '~~> Change path here
    StrPath = "H:\test\"

    With MailOutLook
        .BodyFormat = olFormatRichText
        .To = "test@test.org"
        .Subject = "test"
        .HTMLBody = "test"

        '~~> *.* for all files
        StrFile = Dir(StrPath & "*.*")

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

        '.DeleteAfterSubmit = True
        .Send
    End With

    MsgBox "Reports have been sent", vbOKOnly
End Sub