EXCEL VBA メール作成・送信　Outlookで自動メール作成及びメール送信・自動化・一括送信・複数宛先　（Outlook）

EXCEL VBA メール作成・送信　Outlookで自動メール作成及びメール送信・自動化・一括送信・複数宛先　（Outlook）

EXCEL VBA メール作成・送信　Outlookで自動メール作成（Outlook）

'
'
'
Sub Outlook_Send00() 'OUTLOOKメール作成からメールプレビュー（送信）

  Dim OutlookAP As Outlook.Application
  Dim MailOutlook As Outlook.MailItem
  Set OutlookAP = CreateObject("Outlook.Application")
  Set MailOutlook = OutlookAP.CreateItem(olMailItem)

  With MailOutlook
        .To = "test1@akira55.com"  'Toのメールを設定
        .CC = "test2@akira55.com"  'CCのメールを設定
        .BCC = "test3@akira55.com" 'BCCのメールを設定
        .Subject = "メール送信"    '件名を設定
        .BodyFormat = olFormatHTML 'HTML形式
        .Importance = olImportanceHigh '重要度（高い）
        .Attachments.Add "C:\test1.xlsx"  '1個目の添付ファイル
       ' .Attachments.Add "C:\test2.pdt"  '2個目の添付ファイル
        .Body = "●●様" & vbCr & "いつもお世話になっております。" & vbCr  '本文を設定

        .Display 'メール内容を表示
        
        '.Send    'メール送信する場合は、「Send」を利用する。
  
  End With
  
  Set OutlookAP = Nothing
  Set MailOutlook = Nothing
  
End Sub
'

EXCEL VBA メール作成・送信　Outlookで自動メール作成、一覧表に登録されているメールアードレス宛へ順番にメールを送信（プレビュー表示）します。

'
'
Sub Outlook_Send01() 'Outlookで自動メール作成（リスト作成）

    Dim I, lRow As Long
    Dim OutlookAP As Outlook.Application
    Dim MailOutlook As Outlook.MailItem
    Set OutlookAP = CreateObject("Outlook.Application")
    
    lRow = Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得します。
    
    For I = 2 To lRow  'A列の最終行まで繰り返す。
    
    Set MailOutlook = OutlookAP.CreateItem(olMailItem) 'メールアイテムを作成
        
        With MailOutlook
              .To = Cells(I, "B") 'Toのメールを設定
              .CC = Cells(I, "C")  'CCのメールを設定
              .BCC = Cells(I, "D")   'BCCのメールを設定
              .Subject = Cells(I, "E")   '件名を設定）
              .Attachments.Add "C:\test1.xlsx"  '1個目の添付ファイル
              .Body = Cells(I, "H") & "様" & vbCr & Cells(I, "I") & vbCr '本文を設定
        
              .Display  'プレビュー表示
              '.Save    '下書きに保存
              '.Send    'メール送信
        End With
        
              
    Set MailOutlook = Nothing   '次のメールアイテムを作成するため解放
        
    Next I
    
    Set OutlookAP = Nothing
  
End Sub
'

EXCEL VBA メール作成・送信　Outlookで自動メール作成（Outlook）添付ファイルをダイアログボックスで選択して送信

'
'
Sub Outlook_Send02A() 'Outlookで自動メール作成（リスト作成）
    
    Dim OutlookAP As Outlook.Application
    Dim MailOutlook As Outlook.MailItem
    Dim I, lRow As Long
    Dim TempF As String
    Set OutlookAP = CreateObject("Outlook.Application")
    
    lRow = Cells(Rows.Count, "B").End(xlUp).Row 'B列の最終行を取得します。
    
    TempF = Range("H7") '添付ファイルのファイルパスを代入
    
    For I = 2 To lRow   'B列の最終行まで繰り返す。
    
        If Cells(I, "E") = "●" Then 'E列に”●”があれは、メールを作成
            Set MailOutlook = OutlookAP.CreateItem(olMailItem) 'メールアイテムを作成
                
                With MailOutlook
                      .To = Cells(I, "B") 'Toのメールを設定
                      .Subject = Range("G2")   '件名を設定）
                      .Attachments.Add TempF   '添付ファイル
                      .Body = Cells(I, "C") & vbCr & Cells(I, "D") & "様" & _
                        vbCr & Range("H2") & vbCr & Range("H10") '本文と署名を設定
                
                      .Display  'プレビュー表示
                      '.Save    '下書きに保存
                      '.Send    'メール送信
                End With
                      
            Set MailOutlook = Nothing   '次のメールアイテムを作成するため破棄
        End If
    Next I
    
    Set OutlookAP = Nothing
  
End Sub
'
'
'

Sub Outlook_Send02B()  'Outlookで自動メール作成（添付ファイルを選択）

    Dim FilePath As Variant

    FilePath = Application.GetOpenFilename(FileFilter:="ファイル(*.*),*.*") 'ファイルを選択するダイアログボックスを表示します。
 
    If FilePath = False Then 'ファイルが選択されているか判定します。 Exit Sub 'ファイルが選択されていない場合は、プログラムから抜けます。
            Exit Sub 'プログラムから抜けます。
        Else
            Range("H7") = FilePath '選択したファイルパスをセル（H7)に代入します。
    End If

End Sub
'