如何从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：一键轻松发送个性化电子邮件！

厌倦了逐个发送客户邮件吗？使用 Kutools for Excel 的“发送电子邮件”功能，沟通变得更加快捷和专业！只需准备一个包含姓名、电子邮件地址、注册码等内容的 Excel 工作表，并插入占位符——系统将自动生成个性化邮件，一键发送数百封。告别重复劳动！

• 💡 动态占位符（例如姓名、注册码）会自动为每位收件人填充个性化内容，确保每封邮件都显得独一无二。
• 📎 附加个性化文件，实现精准投递
• 📤 无缝集成 Outlook，安全可靠地发送
• 📝 保存并重复使用电子邮件模板，最大化效率
• 🎨 所见即所得编辑器，简单易用
• 🖋 使用您的 Outlook 签名——无需额外设置，直接发送！
• 立即获取 Kutools For Excel！