Excelから異なるメールアドレスに各シートを送信するにはどうすればよいですか？

複数のワークシートを持つExcelワークブックがあり、それぞれのセルS1にメールアドレスが含まれている場合、各シートを個別の添付ファイルとしてそれぞれの受信者に送信したいかもしれません。この作業は、特に多数のシートを扱う場合、手動で行うと面倒です。このチュートリアルでは、VBAコードを使用して、Excelファイルの各ワークシートを、そのシートのセルS1に指定されたメールアドレスに自動的に送信する方法を紹介します。

VBAコードを使用してExcelから異なるメールアドレスに各シートを送信する

次のVBAコードを使用すると、各ワークシートを、セルS1に記載されている対応する受信者に添付ファイルとして送信できます。以下の手順に従ってください：

1. Alt + F11キーを同時に押して、Microsoft Visual Basic for Applicationsウィンドウを開きます。

2. 次に、 挿入 > モジュールをクリックし、以下のVBAコードをウィンドウにコピーして貼り付けます。

VBAコード: 異なるメールアドレスに各シートを添付して送信する

Sub Mail_Every_Worksheet()
'Updateby ExtendOffice
  Dim xWs As Worksheet
  Dim xWb As Workbook
  Dim xFileExt As String
  Dim xFileFormatNum As Long
  Dim xTempFilePath As String
  Dim xFileName As String
  Dim xOlApp As Object
  Dim xMailObj As Object
  On Error Resume Next
  With Application
      .ScreenUpdating = False
      .EnableEvents = False
  End With
  xTempFilePath = Environ$("temp") & "\"
  If Val(Application.Version) < 12 Then
    xFileExt = ".xls": xFileFormatNum = -4143
  Else
    xFileExt = ".xlsm": xFileFormatNum = 52
  End If
  Set xOlApp = CreateObject("Outlook.Application")
  For Each xWs In ThisWorkbook.Worksheets
    If xWs.Range("S1").Value Like "?*@?*.?*" Then
      xWs.Copy
      Set xWb = ActiveWorkbook
      xFileName = xWs.Name & " of " _
                   & VBA.Left(ThisWorkbook.Name, VBA.InStr(ThisWorkbook.Name, ".") - 1) & " "
      Set xMailObj = xOlApp.CreateItem(0)
      xWb.Sheets.Item(1).Range("S1").Value = ""
      With xWb
        .SaveAs xTempFilePath & xFileName & xFileExt, FileFormat:=xFileFormatNum
        With xMailObj
        'specify the CC, BCC, Subject, Body below
            .To = xWs.Range("S1").Value
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add xWb.FullName
            .Display
        End With
        .Close SaveChanges:=False
      End With
      Set xMailObj = Nothing
      Kill xTempFilePath & xFileName & xFileExt
    End If
  Next
  Set xOlApp = Nothing
  With Application
      .ScreenUpdating = True
      .EnableEvents = True
  End With
End Sub

3. そして、 F5キーを押してこのコードを実行すると、各シートが新しいメッセージウィンドウに自動的に添付ファイルとして挿入されます。スクリーンショットをご覧ください：

4. 最後に、送信ボタンをクリックして、各メールを一つずつ送信します。

Kutools for Excel: たった1クリックで簡単にパーソナライズされたメールを送信！

顧客にメールを1通ずつ送るのはもう疲れていませんか？ Kutools for Excelの「電子メールを送信」機能を使えば、コミュニケーションがより迅速かつプロフェッショナルになります！名前、メールアドレス、登録コードなどを記載したExcelシートを準備し、プレースホルダーを挿入するだけで、システムが自動的にパーソナライズされたメールを生成し、数百通のメールを1クリックで送信します。繰り返しの作業はもう不要です！

• 💡 動的なプレースホルダー（例：名前、登録コード）が各受信者に合わせて自動的に入力され、すべてのメールが独自にカスタマイズされているように感じられます。
• 📎 個別にカスタマイズされたファイルを添付して正確に配信
• 📤 Outlookとシームレスに統合され、安全で信頼性のある送信が可能
• 📝 メールテンプレートを保存して再利用し、最大限の効率を得る
• 🎨 直感的で使いやすいWYSIWYGエディター
• 🖋 Outlookの署名を使用—追加設定は不要、そのまま送信！
• 今すぐKutools For Excelを入手しよう！