web-dev-qa-db-ja.com

複数のファイルまたはディレクトリ全体を電子メールに添付する

ExcelVBAを介して複数の添付ファイル付きのOutlook電子メールを送信しようとしています。

1つの添付ファイル/ファイルへのパスを指定すると、コードは機能します。添付ファイルが何であるかを正確に知っていれば、複数の添付ファイルを追加することもできますが、追加しません。ファイル名だけでなく、さまざまなカウントがあります。

以下の例に示すように、ワイルドカードを使用して送信したいのですが、ディレクトリを指す何らかのループを使用する必要があると思います。

私は見ましたが、私の状況でうまくいくものはまだ見ていません。

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 = "[email protected]"
        .Subject = "test"
        .HTMLBody = "test"
        .Attachments.Add ("H:\test\Adj*.pdf")
        '.DeleteAfterSubmit = True
        .Send
    End With
    MsgBox "Reports have been sent", vbOKOnly
End Sub
excelvbaoutlook
7
gfuller40

これはあなたがしようとしていることですか？ （未テスト）

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 = "[email protected]"
        .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
13
Siddharth Rout