Word ドキュメントのデータと Excel ブックを使用して Outlook からメッセージを送信する VBA マクロ

  • [アーティクル]
  • 適用対象:
    Outlook

概要

この記事では、Microsoft Word ドキュメントのデータと Microsoft Excel ブックを使用して Microsoft Outlook からメッセージを送信するVisual Basic for Applications マクロについて説明します。

詳細

重要

Microsoft は、例示のみを目的としてプログラミング例を提供しており、明示または黙示にかかわらず、いかなる責任も負わないものとします。 これには、市販性または特定の目的との適合性についての黙示の保証も含まれますが、これに限定はされません。 この記事は、説明されているプログラミング言語、手順を作成およびデバッグするために使用されているツールに読者が精通していることを前提にしています。 マイクロソフト サポート窓口では、特定のプロシージャの機能説明に関するご質問に対して支援いたしますが、本例を特定の目的を満たすために機能を追加したり、プロシージャを構築することは行いません。

次の例では、ワークシートに 2 つの定義された名前があることを前提としています。

  • 最初に定義された名前 subjectcell は、メッセージの件名行 ("これはテスト メッセージです" など) を含むセルを参照します。
  • 2 番目に定義された名前 tolist は、受信者のリスト ("John Doe"、"Jane Doe" など) を含む水平方向のリスト内の最初のセルを参照します。

Microsoft Word ドキュメントも必要です。 このドキュメントのテキストは、メール メッセージのメッセージ本文としてマクロによって使用されます。

Sub SendOutlookMessages()'Dimension variables.
    Dim OL As Object, MailSendItem As Object
    Dim W As Object
    Dim MsgTxt As String, SendFile As String
    Dim ToRangeCounter As Variant
    
    'Identifies Word file to send
    SendFile = Application.GetOpenFilename(Title:="Select MS Word " & _
    "file to mail, then click 'Open'", buttontext:="Send", _
    MultiSelect:=False)'Starts Word session
    Set W = GetObject(SendFile)'Pulls text from file for message body
    MsgTxt = W.Range(Start:=W.Paragraphs(1).Range.Start, _
    End:=W.Paragraphs(W.Paragraphs.Count).Range.End)'Ends Word session
    Set W = Nothing
    
    'Starts Outlook session
    Set OL = CreateObject("Outlook.Application")
    Set MailSendItem = OL.CreateItem(olMailItem)
    
    ToRangeCounter = 0
    
    'Identifies number of recipients for To list.
    For Each xCell In ActiveSheet.Range(Range("tolist"), _
    Range("tolist").End(xlToRight))
    ToRangeCounter = ToRangeCounter + 1
    Next xCell
    
    If ToRangeCounter = 256 Then ToRangeCounter = 1
    
    'Creates message
    With MailSendItem
    .Subject = ActiveSheet.Range("subjectcell").Text
    .Body = MsgTxt
    
    'Creates "To" list
    For Each xRecipient In Range("tolist").Resize(1, ToRangeCounter)
    RecipientList = RecipientList & ";" & xRecipient
    Next xRecipient
    
    .To = RecipientList
    .Send
    End With
    
    'Ends Outlook session
    Set OL = Nothing
    
End Sub