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

Question

我正在尝试通过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

Answer 1

这是你在尝试什么？(另)

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