прикрепите несколько файлов для отправки по электронной почте или весь каталог (VBA)

Я пытаюсь отправить электронное письмо с несколькими вложениями через 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:testAdj*.pdf")
            '.DeleteAfterSubmit = True
            .Send
            End With
            MsgBox "Reports have been sent", vbOKOnly
       End Sub
6
excel excel-vba outlook vba

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
11