EXCELマクロでメールの文面に表を張り付けて送る

PC

こんにちは。テレワーカーYです。

今回は、EXCELマクロでメールの文面に何か張り付けて送りたい時に使うマクロのサンプルをお届けします。

サンプルコード

Private Property Get SHEET_SALES_LIST() As Worksheet
    Set SHEET_SALES_LIST = ThisWorkbook.Sheets("担当者メールアドレス")
End Property

Private Property Get SHEET_SALES_RESULT() As Worksheet
    Set SHEET_SALES_RESULT = ThisWorkbook.Sheets("売上一覧")
End Property

Private Property Get RANGE_TABLE() As Range
    Set RANGE_TABLE = SHEET_SALES_RESULT.Range("A1:D4")
End Property

Public Sub sub_Mail()

    Const MAIL_TO As String = "test@test"
    Const MAIL_SUBJECT As String = "タイトル"
    Const MAIL_BODY_TEXT As String = "営業成績" & vbCrLf

    Dim appOutlook As Outlook.Application
    Dim itmMailItem As Outlook.MailItem

    Dim lngRowCustomerList As Long

    Set appOutlook = New Outlook.Application
    
    With appOutlook

        Set itmMailItem = .CreateItem(olMailItem)
        
        With itmMailItem
        
            .To = MAIL_TO
            .Subject = MAIL_SUBJECT
            .BodyFormat = olFormatRichText
        
            .Display
        
        End With
    
        Set itmMailItem = Nothing
    
        With .ActiveInspector.WordEditor.Windows(1).Selection
            .TypeText MAIL_BODY_TEXT
            RANGE_TABLE.Copy
            .Paste
        End With
    
    End With
    
    Set appOutlook = Nothing
        
End Sub

解説

今回も事前準備として、VBEのツール→参照設定でMicrosoft Office 13.0 Object Libraryのチェックを入れておきましょう。

そでは次にコードを見ていきます。

Excelにはオブジェクト定数というものがないので、Property getを使うことで定義しています。

Private Property Get SHEET_SALES_LIST() As Worksheet
    Set SHEET_SALES_LIST = ThisWorkbook.Sheets("担当者メールアドレス")
End Property

Private Property Get SHEET_SALES_RESULT() As Worksheet
    Set SHEET_SALES_RESULT = ThisWorkbook.Sheets("売上一覧")
End Property

Private Property Get RANGE_TABLE() As Range
    Set RANGE_TABLE = SHEET_SALES_RESULT.Range("A1:D4")
End Property

定数は一か所で定義しています。

Public Sub sub_Mail()

    Const MAIL_TO As String = "test@test"
    Const MAIL_SUBJECT As String = "タイトル"
    Const MAIL_BODY_TEXT As String = "営業成績" & vbCrLf

次に、変数の宣言です。型の指定も行います。変数のスコープは小さいほうがいいから、使う直前で定義するという方法もあります。どちらでもいいから、統一することが大事です。ここでは、先頭一か所で宣言しています。

あと、Object型は使わず、オブジェクト変数もすべて型を指定しています。こうしないとエディタの入力補完が使えなくて、作りにくいです。CreateObjectを使って、参照設定を行わないで作る方法もあるにはあるけれど、自分ではやらないかな……。

    Dim appOutlook As Outlook.Application
    Dim itmMailItem As Outlook.MailItem

    Dim lngRowCustomerList As Long

次のところでは、オブジェクト変数をセットしています。Withでまとめることも忘れないようにします。

    Set appOutlook = New Outlook.Application
    
    With appOutlook

次にメールの作成部分。表を張り付けるので、リッチテキストにしているところに注意します。一度表示してから張り付けます。最後にitmMailItemを解放しています。

        With itmMailItem
        
            .To = MAIL_TO
            .Subject = MAIL_SUBJECT
            .BodyFormat = olFormatRichText
        
            .Display
        
        End With
    
        Set itmMailItem = Nothing

ワードエディタで本文を書いたあと、表を張り付けています。

        With .ActiveInspector.WordEditor.Windows(1).Selection
            .TypeText MAIL_BODY_TEXT
            RANGE_TABLE.Copy
            .Paste
        End With
    
    End With

最後にappOutlookのWithを閉じて、解放して終わりです。

    End With
    
    Set appOutlook = Nothing
        
End Sub

コメント

タイトルとURLをコピーしました