web-dev-qa-db-ja.com

VBAを介してExcelから電子メールの添付ファイルを送信する

ボタンをクリックするだけでOutlookを介して自動メールを送信するマクロを作成しました。ファイルを電子メールに添付する方法がわからないことを除いて、すべてがスムーズに実行されます。私が見たすべての場所で、電子メールにファイルを添付するサンプルコードは、静的な名前のファイル用です。たとえば、毎回同じパスで同じファイル名を送信しています。

より便利になった場合、このマクロを実行するボタンは、添付しようとしているブック内にあります。 Windowsエクスプローラーウィンドウを開くのが最も簡単で、その方法でファイルを添付するのが最適かどうかはわかりません。

Sub mySub
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim WeekendingDate As Date

    With Worksheets("Macro Buttons")
        WeekendingDate = Range("N2").Value
    End With

    Set objOutlook = CreateObject("Outlook.Application")

    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

    With objOutlookMsg
        Set objOutlookRecip = .Recipients.Add("blah@blah")
        objOutlookRecip.Type = olTo
       .Subject = "Blah " & WeekendingDate
       .Body = "blah blah blah"

       'Add attachments to the message
       [some code]


       For Each objOutlookRecip In .Recipients
           objOutlookRecip.Resolve
       Next
       If DisplayMsg Then
           .Display
       Else
           .Save
       End If
    End With
    Set objOutlook = Nothing
End Sub
excelvbaemailoutlookemail-attachments
6
Davey

MailItemセットアップに挿入されるAttachments.Addコードが必要です。

With objOutlookMsg
    Set objOutlookRecip = .Recipients.Add("blah@blah")
    objOutlookRecip.Type = olTo
   .Subject = "Blah " & WeekendingDate
   .Body = "blah blah blah"
'Add attachments to the message [some code]
   .Attachments.Add "pathToFile"
   For Each objOutlookRecip In .Recipients
       objOutlookRecip.Resolve
   Next
   If DisplayMsg Then
       .Display
   Else
       .Save
   End If
End With
Set objOutlook = Nothing

私自身のスクリプトの1つで、Dictionaryオブジェクトと次のコードを使用して添付するMailItemに添付ファイルのコレクションを渡します。

With oMailItem
        Set .SendUsingAccount = oOutlook.Session.Accounts.Item(iAccount)
        .To = EmailData("To")
        .CC = EmailData("CC")
        .BCC = EmailData("BCC")
        .Subject = EmailData("Subject")
        .Body = EmailData("Body")
        sAttachArray = Split(EmailData("AttachmentPaths"), ";")
        For Each sAttachment In sAttachArray
            .Attachments.Add(sAttachment)
        Next
        .Recipients.ResolveAll
        .Display    ' debug mode - uncomment this to see email before it's sent out
    End With
10
Dave