[分享] 跟我來(lái)！ 一步一步教你批量發(fā)送郵件

引用 聞啟學(xué) 2019-4-14 11:07

本帖最后由 聞啟學(xué) 于 2019-4-14 11:20 編輯

小聞：劉老師， 新建一個(gè)郵件我知曉，但是多個(gè)郵件呢！�。�
劉老師： 小聞，你不會(huì)轉(zhuǎn)彎嗎？ 我來(lái)問(wèn)你，如果在Excel  VBA  中怎樣完成一個(gè)重復(fù)的事情。

小聞： 這個(gè)肯定用循環(huán)語(yǔ)句啊，還用想嗎?那在outlook VBA 可以使用嗎！
劉老師：不嘗試過(guò)就知道不行，代碼是測(cè)試出來(lái)的，不是講出來(lái)的  

2，向同一個(gè)人發(fā)多個(gè)郵件
如果要向同一個(gè)郵箱發(fā)送多個(gè)郵件 怎么辦！ 可以這樣考慮 上面已經(jīng)知道發(fā)送一個(gè)郵件的代碼 能否再改進(jìn)一下！ Come on body

1. Sub SandMoreMail()
   
2.     Dim OutApp As outlook.Application  ‘//定義outlook的對(duì)象變量
   
3.     Dim oItem As outlook.MailItem    ‘//定義outlook郵件的對(duì)象變量
   
4.    Set OutApp = New outlook.Application  ‘//創(chuàng)建outlook對(duì)象
   
5.     For i=1  to  50  ‘//循環(huán)體
   
6.        Set oItem = OutApp.CreateItem(olMailItem)  ‘//創(chuàng)建一封新的郵件
   
7.         With oItem
   
8.         .To = "l"   ‘//郵件收件人 自己寫(xiě)入郵箱
   
9.         .CC = “”  ‘//郵件抄送人自己寫(xiě)入郵箱
   
10.         .Subject = “第” & I & “封郵件發(fā)送”  ‘//組合郵件的主題內(nèi)容
    
11.         .BodyFormat = olFormatHTML  ‘//設(shè)置郵件格式 是否html 格式的
    
12.         .Attachments.Add "D:" & myatt  ‘//添加附件
    
13.         .Body = “你好！！第” & I & “封郵件發(fā)送”   ‘//郵主體內(nèi)容
    
14.         .Display    ‘//新建郵件窗口顯示
    
15.         .send   ‘//郵件發(fā)送   
    
16. End With
    
17. Next
    
18. End Sub
    

復(fù)制代碼

引用 聞啟學(xué) 2019-4-14 11:11

小聞： 老師 如果我要每一封郵件不同收件人和相同附件呢
劉老師： 這個(gè)要用一個(gè)數(shù)據(jù)源 來(lái)存儲(chǔ)這些收件人和郵箱地址 ，用循環(huán)獲得這樣數(shù)據(jù) 發(fā)送郵件  我現(xiàn)在用數(shù)組保存數(shù)據(jù)

1. Sub hhh()
   
2.     Dim arr
   
3.     arr = Array(Array("序號(hào)", "主題", "主體", "郵箱"), Array(1, "測(cè)試郵件", "你好，測(cè)試郵件進(jìn)行中�。�！", "lyhschool@163.com"), Array(2, "測(cè)試郵件", "你好，測(cè)試郵件進(jìn)行中！�。�", "417149126@qq.com"))
   
4.     Dim OutApp As Outlook.Application  '//定義outlook的對(duì)象變量
   
5.     Dim oItem As Outlook.MailItem    '//定義outlook郵件的對(duì)象變量
   
6.     Set OutApp = New Outlook.Application  '//創(chuàng)建outlook對(duì)象
   
7.    dim  myatt  as string
   
8.    myatt  =“D:\5.jpg”
   
9.     For i = 1 To UBound(arr(0)) - 1
   
10.         Set oItem = OutApp.CreateItem(olMailItem)  '//創(chuàng)建一封新的郵件
    
11.         With oItem
    
12.             .To = arr(i)(3)   '//郵件收件人
    
13.             '// .CC = "417149126@qq.com"  '//郵件抄送人
    
14.             .Subject = arr(i)(1)    '//郵件的主題
    
15.             .BodyFormat = olFormatHTML  '//設(shè)置郵件格式 是否html 格式的
    
16.            '// .Attachments.Add myatt   '//添加附件
    
17.             .Body = arr(i)(2)  '//郵主體內(nèi)容
    
18.            '// .Display    '//新建郵件窗口顯示
    
19.             .Send   '//郵件發(fā)送
    
20.         End With
    
21.     Next
    
22. End Sub
    

復(fù)制代碼

引用 聞啟學(xué) 2019-4-14 11:13

小聞：老師，我的數(shù)據(jù)源在Excel 表里 在outlook 怎樣獲得Excel 表的數(shù)據(jù)啊
劉老師： 這個(gè)是office 的協(xié)同問(wèn)題啊  可以在outlook 綁定Excel的 程序 引用：Microseft Excel*.0 Object Library 或者可以在EXcel綁定 outlook 程序  我的習(xí)慣就是這個(gè)  

綁定分為 前期綁定 和后期綁定

前期綁定 點(diǎn)擊菜單欄 --->工具 -->引用-->對(duì)應(yīng)項(xiàng)目  Microseft Excel*.0 Object Library  or Microseft    outlook *.0 Object Library

后期綁定  使用代碼 set xlapp =createobject("Excel.application") '// 引用Excel 程序  
set outlooklapp =createobject("outlook.application") '// 引用outlook程序

1. '*******************************************************************
   
2. '程序名稱：最完美的利用EXCEL自動(dòng)批量發(fā)送郵件
   
3. 
   
4. '
   
5. '經(jīng)測(cè)試在OUTLOOK 2000中不會(huì)顯示警告窗口.
   
6. 
   
7. '引用：Microseft Outlook *.0 Object Library
   
8. 
   
9. '需要注意一點(diǎn) , 郵件的標(biāo)題, 否則不能自動(dòng)放送!
   
10. 
    
11. '**********************************************************************
    
12. 
    
13. Sub 批量發(fā)送郵件()
    
14. 
    
15. '要能正確發(fā)送并需要對(duì)Microseft Outlook進(jìn)行有效配置
    
16. 
    
17.     On Error Resume Next
    
18.     Dim rowCount, endRowNo
    
19.     '要正常運(yùn)行下面這句,要將工具/引用中的Microseft Outlook *.0 Object Library(其中*為你Microseft Outlook的版本號(hào))選上
    
20.     Dim objOutlook As New Outlook.Application
    
21.     Dim objMail As MailItem
    
22.     '取得當(dāng)前工作表與Cells(1,1)相連的數(shù)據(jù)區(qū)行數(shù)
    
23.     endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
    
24.     '創(chuàng)建objOutlook為Outlook應(yīng)用程序?qū)ο?br />
25.     Set objOutlook = New Outlook.Application
    
26.     '開(kāi)始循環(huán)發(fā)送電子郵件
    
27.     For rowCount = 2 To endRowNo
    
28.         '創(chuàng)建objMail為一個(gè)郵件對(duì)象
    
29.         Set objMail = objOutlook.CreateItem(olMailItem)
    
30.         With objMail
    
31.             '設(shè)置收件人地址（從通訊錄表的'E-mail地址'字段中獲得）
    
32.             .To = Cells(rowCount, 1)
    
33.             '設(shè)置郵件主題
    
34.             .Subject = Cells(rowCount, 2)
    
35.             '設(shè)置郵件內(nèi)容（從通訊錄表的'內(nèi)容'字段中獲得）
    
36.             .Body = Cells(rowCount, 3)
    
37.             '設(shè)置附件（從通訊錄表的'附件'字段中獲得）
    
38.             .Attachments.Add Cells(rowCount, 4).value
    
39.             '自動(dòng)發(fā)送郵件
    
40.             .Send
    
41.         End With
    
42.         '銷毀objMail對(duì)象
    
43.         Set objMail = Nothing
    
44.     Next
    
45.     '銷毀objOutlook對(duì)象
    
46.     Set objOutlook = Nothing
    
47.     '所有電子郵件發(fā)送完成時(shí)提示
    
48.     MsgBox rowCount - 1 & "個(gè)朋友的問(wèn)候信發(fā)送成功！"
    
49.     '
    
50.     If Application.Workbooks.Count = 1 Then
    
51.         Application.Quit
    
52.     Else
    
53.         Workbooks("自動(dòng)發(fā)送郵件.xls").Close
    
54.     End If
    
55.     '
    
56. End Sub
    

復(fù)制代碼

引用 聞啟學(xué) 2019-4-14 11:18

一對(duì)多的 郵件

這種郵件 一般用在對(duì)部門(mén)經(jīng)理匯報(bào)員工情況之類的
分析下 其實(shí)這個(gè)是簡(jiǎn)單的 拆分工作表的 只不過(guò)拆分后 放在郵件中  

1，數(shù)據(jù)重組
   按某個(gè)關(guān)鍵字拆分工作表 ，利用字典去重
2，郵件
   郵件正文
  循環(huán)數(shù)組，獲得對(duì)應(yīng)字典健的數(shù)組
   遍歷數(shù)組中的數(shù)據(jù)，用字符組合成Html格式文本
  根據(jù)關(guān)鍵字獲得郵件地址和收件人的名字

QQ截圖20190413102013.png (143.13 KB, 下載次數(shù): 0)

下載附件  保存到相冊(cè)

2019-4-14 11:17 上傳

引用 tmtony 2019-4-15 12:46

贊一個(gè)，不錯(cuò)哦。
之前不是轉(zhuǎn)VSTO，又轉(zhuǎn)回VBA了？

查看全部評(píng)論(5)