こんにちは。テレワーカー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
コメント