如何將 Excel 中的每張工作表分別寄送到不同的郵箱地址？

作者Xiaoyang修改日期2025-03-28

如果您有一個包含多張工作表的 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

注意：上述程式碼中：

S1 是存放您要寄送電子郵件之郵箱地址的儲存格。若您的郵箱地址位於其他儲存格（例如）A1），只需修改程式碼即可反映此變更。
您可以在程式碼中自行指定副本（CC）、密件副本（BCC）、主旨與內文；
若要直接寄送電子郵件，而不開啟下列新郵件視窗，請將 .Display 改為 .Send。

VBA 程式碼視窗的截圖，用於將 Excel 中每個工作表傳送至儲存格 S1 中指定的不同電子郵件地址

3. 接著，按下 F5 鍵執行此程式碼，即可自動將每張工作表插入新郵件視窗作為附件，如下方截圖所示：

Outlook 中新郵件的截圖，每封郵件皆附上一個 Excel 工作表並寄送給不同收件者

4. 最後，點擊傳送按鈕，即可逐一寄出每封電子郵件。

Kutools for Excel：一鍵輕鬆寄送個人化郵件！

還在一封一封手動寄送客戶郵件嗎？透過 Kutools for Excel 的「寄送郵件」功能，讓溝通更快速、更專業！只需準備一份包含姓名、電子信箱、註冊碼及插入佔位符的 Excel 表格，系統便能自動生成個人化郵件，並一鍵寄出數百封，徹底告別重複勞動！

💡 動態佔位符（例如姓名、註冊碼）會自動填入每位收件人的專屬資訊，讓每封郵件都顯得獨一無二。
📎 附加個人化檔案，確保準確送達
📤 無縫整合 Outlook，安全可靠地寄送郵件
📝 儲存並重複使用電子郵件範本，發揮最高效率
🎨 所見即所得編輯器，操作簡單直覺
🖋 直接使用您的 Outlook 簽名檔——無需額外設定，點擊「傳送」立即搞定！
立即取得 Kutools for Excel！

最佳 Office 生產力工具

🤖	KUTOOLS AI 助手：基於以下內容徹底革新數據分析：智慧執行｜產生程式碼｜建立自訂公式｜分析資料並產生圖表｜呼叫增強函數……
	熱門功能：尋找、醒目提示或標記重複值｜刪除空白行｜合併列或儲存格而不遺失資料｜不使用公式的四捨五入……
	高級 LOOKUP：多重條件 VLookup ｜多重數值 VLookup ｜跨多個工作表 VLookup ｜模糊查找……
	高級下拉列表：快速建立下拉式清單｜相依式下拉式清單｜多選下拉式清單……
	欄位管理員：新增指定數量的欄位｜移動欄位｜切換隱藏欄位的可見狀態｜比較範圍與欄位……
	精選功能：網格聚焦｜設計視圖｜增強編輯欄｜工作簿與工作表管理員｜資源庫（自動文字）｜日期提取｜合併工作表｜加密／解密儲存格｜依清單傳送電子郵件｜超級篩選｜特殊篩選（篩選粗體儲存格／斜體／刪除線……） ......
	頂尖 15 工具組：12 文字工具（添加文本，刪除特定字符，……）｜ 50+ 圖表類型（甘特圖，……）｜ 40+ 實用公式（基於生日計算年齡，……）｜ 19 插入工具（插入二維碼，從路徑插入圖片，……）｜ 12 轉換工具（金額轉大寫，匯率轉換，……）｜ 7 合併和拆分工具（高級合併行，分割儲存格，……）｜……以及更多