Note: The other languages of the website are Google-translated. Back to English

 如何通過Outlook從Excel向列表中的多個收件人發送電子郵件?

如果您現在在工作表的一列中有多個電子郵件地址,則想直接從Excel發送電子郵件到此收件人列表,而無需打開Outlook。 本文,我將討論如何同時從Excel向多個收件人發送電子郵件。

使用VBA代碼從Excel向多個收件人發送電子郵件

使用VBA代碼將電子郵件與當前工作簿作為附件發送給多個收件人


箭頭藍色右氣泡 使用VBA代碼從Excel向多個收件人發送電子郵件

您可以使用VBA代碼一次將郵件發送給多個收件人,請執行以下操作:

1. 按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications 窗口。

2. 點擊 插入 > 模塊,然後將以下代碼粘貼到 模塊窗口.

VBA代碼:向多個收件人發送電子郵件

Sub sendmultiple()
'updateby Extendoffice
    Dim xOTApp As Object
    Dim xMItem As Object
    Dim xCell As Range
    Dim xRg As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the addresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOTApp = CreateObject("Outlook.Application")
    For Each xCell In xRg
        If xCell.Value Like "*@*" Then
            If xEmailAddr = "" Then
                xEmailAddr = xCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & xCell.Value
            End If
        End If
    Next
    Set xMItem = xOTApp.CreateItem(0)
    With xMItem
        .To = xEmailAddr
        .Display
    End With
End Sub

3。 然後按 F5 執行此代碼的關鍵,將彈出一個提示框,提醒您選擇地址列表,請參見屏幕截圖:

doc發送多個收件人1

4。 然後點擊 OK和展望 留言內容 窗口顯示,您可以看到所有選定的電子郵件地址已添加到 字段,然後您可以輸入主題並撰寫您的信息,請參見屏幕截圖:

doc發送多個收件人2

5。 完成留言後,請點擊 發送 按鈕,此消息將發送到您的工作表列表中的這些收件人。


箭頭藍色右氣泡 使用VBA代碼將電子郵件與當前工作簿作為附件發送給多個收件人

如果您需要使用當前工作簿作為附件將消息發送給多個收件人,則可以應用以下VBA代碼。

1。 按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications 窗口。

2。 點擊 插入 > 模塊,然後將以下代碼粘貼到 模塊窗口.

VBA代碼:使用當前工作簿作為附件向多個收件人發送電子郵件

Sub EmailAttachmentRecipients()
'updateby Extendoffice
    Dim xOutlook As Object
    Dim xMailItem As Object
    Dim xRg As Range
    Dim xCell As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the arresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOutlook = CreateObject("Outlook.Application")
    Set xMailItem = xOutlook.CreateItem(0)
    For Each xCell In xRg
        If xCell.Value Like "*@*" Then
            If xEmailAddr = "" Then
                xEmailAddr = xCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & xCell.Value
            End If
        End If
    Next
    With xMailItem
        .To = xEmailAddr
        .CC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add ActiveWorkbook.FullName
        .Display
    End With
    Set xOutlook = Nothing
    Set xMailItem = Nothing
End Sub

3。 粘貼代碼後,按 F5 鍵運行此代碼,並彈出一個提示框,提醒您選擇要將消息發送到的地址,請參見屏幕截圖:

doc發送多個收件人3

4. 然後點擊 OK 按鈕和一個Outlook 留言內容 顯示窗口,所有電子郵件地址已添加到 字段,並且您當前的工作簿也已作為附件插入,然後您可以輸入主題並撰寫消息,請參見屏幕截圖:

doc發送多個收件人4

5。 然後點擊 發送 按鈕將該消息發送到帶有當前工作簿作為附件的收件人列表。


向具有不同附件的多個收件人發送個性化電子郵件:

這款獨特的敏感免洗唇膜採用 Moisture WrapTM 技術和 Berry Mix ComplexTM 成分, Excel的Kutools's 發電子郵件 功能,您可以根據需要通過Outlook通過Excel將個性化電子郵件快速發送給具有不同附件的多個收件人。 同時,您也可以抄送或密送給特定人員的郵件。 點擊下載Kutools for Excel!

doc發送個性化電子郵件18 1


相關文章:

如何通過Outlook從Excel向列表發送個性化的群發電子郵件?


最佳辦公效率工具

Kutools for Excel 解決了你的大部分問題,並將你的生產力提高了 80%

  • 重用: 快速插入 複雜的公式,圖表 以及您以前使用過的任何東西; 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 超級公式欄 (輕鬆編輯多行文本和公式); 閱讀版式 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不會丟失數據; 拆分單元格內容; 合併重複的行/列...防止細胞重複; 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 (所有單元格都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇...
  • 確切的副本 多個單元格,無需更改公式參考; 自動創建參考 到多張紙; 插入項目符號,複選框等...
  • 提取文字,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級濾鏡 (將過濾方案保存並應用於其他工作表); 高級排序 按月/週/日,頻率及更多; 特殊過濾器 用粗體,斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表; 將數據分割成多個工作表; 批量轉換xls,xlsx和PDF...
  • 超過 300 項強大的功能. 支持 Office / Excel 2007-2021 和 365。支持所有語言。 在您的企業或組織中輕鬆部署。 完整功能 30 天免費試用。 60 天退款保證。
kte選項卡201905

Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
按評論排序
留言 (20)
還沒有評分。 成為第一位評論!
網站主持人對此評論進行了最小化
這太棒了,正是我想要的。 無論如何要添加一個功能,您可以在其中使用代碼向主題行添加消息....我不希望消息框中的任何內容
網站主持人對此評論進行了最小化
嗨,VBA 代碼對我來說運行良好,謝謝。 有什麼方法可以創建一個帶有觸發“選擇郵件列表”彈出的按鈕的單元格? 傑克
網站主持人對此評論進行了最小化
你好,謝謝你的代碼。 有沒有辦法我可以在 excel 上創建一個命令按鈕,然後通過單擊該按鈕,可以將同一個 excel 表作為附件發送給多個收件人。
網站主持人對此評論進行了最小化
我怎樣才能使用密件抄送行做到這一點?
網站主持人對此評論進行了最小化
嗨,羅伯特,
運行代碼後,將打開新的消息窗口,您只需在選項選項卡下插入密件抄送行,見以下截圖:


希望對你有幫助,謝謝!
查看附件 (1 / 5)
網站主持人對此評論進行了最小化
有什麼方法可以使用它從共享電子郵件發送? 我似乎無法插入 .SendOnBehalfOf 字段。
網站主持人對此評論進行了最小化
你好 ! 每個月我都應該為不同的提供商發送相同的電子郵件,但他們不應該在同一個電子郵件中......如果沒有每個人都在同一個電子郵件中,我怎麼能為不同的目的地發送相同的電子郵件?
網站主持人對此評論進行了最小化
你好,維尼修斯,
要將同一封郵件分別發送給多個收件人,以下文章可能對您有所幫助,請查看。
https://www.extendoffice.com/documents/excel/3560-excel-send-personalized-email.html
網站主持人對此評論進行了最小化
早上,


我是嘗試在 excel 中編寫和使用宏的新手。 我的第一次嘗試是嘗試從一個大型主列表創建一個子集群發電子郵件。 我剪切並粘貼了第一個例程,然後嘗試使用它,它所做的只是突出顯示我請求的單元格。 沒有創建 Outlook 電子郵件,我做錯了什麼? 為了擴展我的實際要求,我真的想通過郵政編碼或其他子集來定位電子郵件。 如何創建一個宏來搜索給定郵政編碼的列並創建包含找到的所有收件人的電子郵件?

感謝

史蒂夫
網站主持人對此評論進行了最小化
我有此代碼,我的問題是每次條件不完整時它都會創建一封電子郵件,但我想將所有未達到條件的信息放在一封電子郵件中

子 EnviarCorreo()
將 OutApp 調暗為對象
將 OutMail 作為對像變暗
將 lLastRow 變暗
將 lRow 變暗
將 sSendTo 調暗為字符串
將 sSendCC 調暗為字符串
將 sSendBCC 調暗為字符串
將 sSubject 調暗為字符串
將 sTemp 調暗為字符串

設置 OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

' 根據需要更改以下內容
sSendTo = ""
sSendCC = ""
sSendBCC = ""
sSubject = "到期日已到"

設置 OutMail = OutApp.CreateItem(0)

lLastRow = 單元格(Rows.Count, 3).End(xlUp).Row
對於 lRow = 3 到 lLastRow
如果 Cells(lRow, 9) <> "S" 那麼
If Cells(lRow, 2) <= Date Then

在錯誤恢復下一頁
隨著OutMail
.To = 發送到
如果 sSendCC > "" 那麼 .CC = sSendCC
如果 sSendBCC > "" 那麼 .BCC = sSendBCC
.Subject = s主題

sTemp = "你好!" & vbCrLf & vbCrLf
sTemp = sTemp & "到期日已到"
sTemp = sTemp & "對於這個項目:" & vbCrLf & vbCrLf


'這是我想在電子郵件正文中重複的內容
' 假設項目名稱在 B 列
sTemp = sTemp & "ID:"
sTemp = sTemp & " " & Cells(lRow, 1)
sTemp = sTemp & " 描述: "
sTemp = sTemp & " " & Cells(lRow, 5)
sTemp = sTemp & "請取適當"
sTemp = sTemp & “動作”。 & vbCrLf & vbCrLf
sTemp = sTemp & “謝謝!” & vbCrLf
'直到這裡



.Body = 溫度
' 如果需要,請將以下內容更改為 .Send
' 發送消息而不先審閱
。顯示
結束
設置 OutMail = 無

單元格(lRow,9)=“S”
Cells(lRow, 10) = "電子郵件發送時間:" & Now()
如果結束
如果結束
下一行
設置 OutApp = 無
END SUB
網站主持人對此評論進行了最小化
是否可以在選擇 TO 後以相同的方式從列表中選擇 CC 的代碼? 使用現有代碼,不可能像 TOs(主要地址)一樣選擇任何 CC。 
網站主持人對此評論進行了最小化
你好,尤金,很高興為您提供幫助。 在選擇 TO 之後,可以以相同的方式從列表中選擇 CC 的代碼。 並且代碼與TOs VBA代碼基本相同。 只應進行一項更改。 只需將“.To = xEmailAddr”更改為“.Cc = xEmailAddr”。 請看截圖。 您可以同時從列表中選擇 CC 和 TO。 只需將“.To = xEmailAddr”和“.Cc = xEmailAddr”都包含在 VBA 代碼中即可。 請在模塊窗口中粘貼以下代碼。
子 sendmultiple()
'更新 Extendoffice
將 xOTApp 調暗為對象
將 xMItem 調暗為對象
將 xCell 調暗為範圍
將 xRg 調暗為範圍
將 xEmailAddr 調暗為字符串
將 xTxt 調暗為字符串
在錯誤恢復下一頁
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("請選擇地址列表:", "Kutools for Excel", xTxt, , , , , 8)
如果 xRg 什麼都不是,則退出 Sub
設置 xOTApp = CreateObject("Outlook.Application")
對於 xRg 中的每個 xCell
如果 xCell.Value 像 "*@*" 則
如果 xEmailAddr = "" 那麼
xEmailAddr = xCell.Value
其他
xEmailAddr = xEmailAddr & ";" & xCell.Value
如果結束
如果結束
下一頁
設置 xMItem = xOTApp.CreateItem(0)
使用 xMItem
.To = xEmailAddr
.Cc = xEmailAddr
。顯示
結束
END SUB

希望它能解決你的問題。 祝你有美好的一天。真誠的,曼迪
查看附件 (1 / 5)
網站主持人對此評論進行了最小化
我正在嘗試讓 excel 向多個收件人發送電子郵件,並且可以獲得我需要的一切,但它拒絕將電子郵件地址放在 TO 框中。 這是我一直在使用的代碼。 誰能幫我弄清楚我做錯了什麼? 非常感謝!

Sub Macro1()
將單元格調暗為範圍
將 rngMyDataSet 調暗為範圍
昏暗範圍
將 OutApp 調暗為對象
將 OutMail 作為對像變暗
將 EmailSubject 暗淡為字符串
將 EmailSendTo 調暗為字符串
將 MailBody 調暗為字符串
將 EmailRecipient 變暗為範圍
暗淡簽名為字符串
Application.ScreenUpdating = False
使用ActiveSheet
如果 .FilterMode 則 .ShowAllData
設置 Rng = .Range("AK6", .Cells(.Rows.Count, 1).End(xlUp))
結束
對於 Rng 中的每個 rngCell
如果 rngCell.Offset(0, 6) > 0 那麼

ElseIf rngCell.Offset(0, 5) > Evaluate("Today() +7") And _
rngCell.Offset(0, 5).Value <= Evaluate("Today() +30") 然後
rngCell.Offset(0, 6).Value = 日期

設置 OutApp = CreateObject("Outlook.Application")
設置 OutMail = OutApp.CreateItem(0)

strbody = "根據我的記錄,您的合同 " & Range("A6").Value & " 應在 " & rngCell.Offset(0, 5).Value & vbNewLine & _
“請在相關日期之前查看本合同,並將您對本合同所做的任何更改通過電子郵件發送給我。如果續簽,請填寫可在所有人文件夾中找到的合同封面,並將新的原始合同發送給我。 "
EmailSendTo = rngCell.Offset(0, 0).Value
EmailSubject = Sheets("sheet1").Range("A6").Value
簽名 = "C:\Documents and Settings\" & Environ("rmm") & _
"\Application Data\Microsoft\Signatures\rm.htm"
在錯誤恢復下一頁
隨著OutMail
.To = EmailSendTo
.CC = "hhh@gmail.com"
.BCC =“”
.Subject = 電子郵件主題
.Body = strbody
。顯示
Send_Value = Mail_Recipient.Offset(i - 1).Value
結束
在錯誤轉到0
設置 OutMail = 無
設置 OutApp = 無

如果結束

下一個 rngCell
Application.ScreenUpdating = True
END SUB
網站主持人對此評論進行了最小化
你好,戴安娜,
也許您可以應用以下代碼:

Sub Macro1()
Dim rngCell As Range
Dim Rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
Dim Signature As String
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet
  If .FilterMode Then .ShowAllData
  Set Rng = .Range("AK6", .Cells(.Rows.Count, 1).End(xlUp))
End With
Set OutApp = CreateObject("Outlook.Application")
For Each rngCell In Rng
  If rngCell.Offset(0, 6) > 0 Then
    If rngCell.Offset(0, 5).Value > Evaluate("Today() +7") And _
       rngCell.Offset(0, 5).Value <= Evaluate("Today() +30") Then
      rngCell.Offset(0, 6).Value = Date
    End If
    Set OutMail = OutApp.CreateItem(0)
    MailBody = "According to my records, your contract " & Range("A6").Value & " is due for review on " & rngCell.Offset(0, 6).Value & vbNewLine & _
               "Please review this contract prior to the pertinent date and email me with any changes you make to this contract. If it is renewed, " & _
               "please fill out the Contract Cover Sheet which can be found in the Everyone folder and send me the new original contract."
    
    EmailSendTo = rngCell.Offset(2, 6).Value   'Please specify the row and column number of the addresses in the filtered data range,please change the number 2 and 6 to your need
    EmailSubject = Sheets("sheet1").Range("A6").Value
    Signature = "C:\Documents and Settings\" & Environ("rmm") & _
                "\Application Data\Microsoft\Signatures\rm.htm"
    With OutMail
      .To = EmailSendTo
      .CC = "hhh@gmail.com"
      .BCC = ""
      .Subject = EmailSubject
      .Body = MailBody
      .Recipients.ResolveAll
      .Display
    End With
  End If
Next rngCell
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub



EmailSendTo = rngCell.Offset(2, 6).Value,您應該根據您的數據范圍將數字 2 和 6 更改為行號和列號,此範圍包含您要發送到的電子郵件地址。

請嘗試,希望對您有所幫助!
網站主持人對此評論進行了最小化
謝謝你,但不幸的是它沒有用。 我仍然得到相同的結果。
網站主持人對此評論進行了最小化
嗨,戴安娜,
在這種情況下,請提供工作表數據的屏幕截圖或附件文件,以便我們確定問題所在。
或者您可以更清楚、更詳細地描述您的問題。
感謝您!
網站主持人對此評論進行了最小化
以下是我正在使用的當前代碼,但它不會將每個電子郵件地址放入 TO 框中,而只會將所有電子郵件地址中的第一個電子郵件地址放入其中。 也對 SUBJECT 和在電子郵件中做同樣的事情,它只是一次又一次地使用同樣的事情。 我不確定如何將電子表格附加到這封電子郵件。

Sub Macro1()
將單元格調暗為範圍
將 rngMyDataSet 調暗為範圍
昏暗範圍
將 OutApp 調暗為對象
將 OutMail 作為對像變暗
將 EmailSubject 暗淡為字符串
將 EmailSendTo 調暗為字符串
將 MailBody 調暗為範圍
將 EmailRecipient 變暗為範圍
暗淡簽名為字符串
Application.ScreenUpdating = False
使用ActiveSheet
如果 .FilterMode 則 .ShowAllData
設置 Rng = .Range("AJ6", .Cells(.Rows.Count, 1).End(xlUp))
結束
對於 Rng 中的每個 rngCell
如果 rngCell.Offset(0, 6) > 0 那麼

ElseIf rngCell.Offset(0, 5) > Evaluate("Today() +7") And _
rngCell.Offset(0, 5).Value <= Evaluate("Today() +120") 然後
rngCell.Offset(0, 6).Value = 日期

設置 OutApp = CreateObject("Outlook.Application")
設置 OutMail = OutApp.CreateItem(0)

strbody = "根據我的記錄,您的 " & Range("A6").Value & " 合同到期審查 " & rngCell.Offset(0, 5).Value & _
”。請務必盡快查看此合同,並將任何更改通過電子郵件發送給我。如果續簽,請填寫合同封面,該封面可在所有人文件夾中找到,並將封面與新的原始合同一起發送給我。”
EmailSendTo = Sheets("sheet1").Range("AJ6").Value
EmailSubject = Sheets("sheet1").Range("A6").Value
簽名 = "C:\Documents and Settings\" & Environ("rmm") & _
"\Application Data\Microsoft\Signatures\rm.htm"
在錯誤恢復下一頁
隨著OutMail
.To = EmailSendTo
.CC = "hhh@gmail.com"
.BCC =“”
.Subject = 電子郵件主題
.Body = strbody
。顯示
Send_Value = Mail_Recipient.Offset(i - 1).Value
結束
在錯誤轉到0
設置 OutMail = 無
設置 OutApp = 無

如果結束

下一個 rngCell
Application.ScreenUpdating = True
END SUB
網站主持人對此評論進行了最小化
你好,
您可以在此處將工作簿作為附件插入,請參見以下屏幕截圖:
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-attachment-1.png
感謝您!
網站主持人對此評論進行了最小化
我這邊沒有“上傳附件”框。
網站主持人對此評論進行了最小化
你好,戴安娜,
如果沒有“上傳附件”框,請先註冊,然後會出現“上傳附件”選項。
要註冊,請到文章頂部,然後點擊 註冊 按鈕開始。
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-register.png
對不起給您帶來不便。
這裡還沒有評論
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護