企業(yè)制作工資表,利用Excel+outlook批量快速發(fā)送電子郵件

1、Excel 和outlook 結(jié)合自己制作出可以群發(fā)工資的程序，然后通過HTML語言實(shí)現(xiàn)排版的表格化。首先是實(shí)現(xiàn)EXCLE 中VB 自動調(diào)用OUTLOOK 的語句，舉一反三。1 .準(zhǔn)備通過以下是通過HTML 做的一個(gè)表格的部分，具體的數(shù)據(jù)項(xiàng)則通過VB 來索引實(shí)現(xiàn)。效果如下你好=1=,下面是你2月份的<font color="red"><b>工資</b></font>，明細(xì)如下：<table align="center" width="500" height="25&quo

2、t; border=1 bordercolor="#000000"><tbody><tr><td colspan="4" align="center"> 工資表 </td></tr><tr><td width="25%" height="25">薪酬等級 </td><td width="25%" height="25">=2= </td&

3、gt;<td width="25%" height="25">稿費(fèi)、其它 </td><td width="25%" height="25">=3= </td></tr><tr><td width="25%" height="25">薪檔 </td><td width="25%" height="25">=4= </td>

4、;<td width="25%" height="25">崗位津貼 </td><td width="25%" height="25">=6= </td></tr><tr><td width="25%" height="25">基本工資 </td><td width="25%" height="25">=4= </td>

5、<td width="25%" height="25">應(yīng)發(fā)合計(jì) </td><td width="25%" height="25">=6= </td></tr><tr><td width="25%" height="25">崗位工資 </td><td width="25%" height="25">=4= </td>&

6、lt;td width="25%" height="25">扣公積金 </td><td width="25%" height="25">=6= </td></tr><tr><td width="25%" height="25">補(bǔ)貼 </td><td width="25%" height="25">=4= </td><

7、td width="25%" height="25">扣統(tǒng)籌保險(xiǎn) </td><td width="25%" height="25">=6= </td></tr><tr><td width="25%" height="25">工齡工資 </td><td width="25%" height="25">=4= </td><

8、td width="25%" height="25">扣醫(yī)療保險(xiǎn) </td><td width="25%" height="25">=6= </td></tr><tr><td width="25%" height="25">特補(bǔ)、獨(dú)子 </td><td width="25%" height="25">=4= </td><

9、;td width="25%" height="25">扣失業(yè)保險(xiǎn) </td><td width="25%" height="25">=6= </td></tr><tr><td width="25%" height="25">加班費(fèi) </td><td width="25%" height="25">=4= </td><

10、td width="25%" height="25">計(jì)稅工資 </td><td width="25%" height="25">=6= </td></tr><tr><td width="25%" height="25">事假等扣款 </td><td width="25%" height="25">=4= </td><

11、td width="25%" height="25">扣稅金 </td><td width="25%" height="25">=6= </td></tr><tr><td colspan="2" align="center" width="50%" height="25">實(shí)發(fā)合計(jì) </td><td colspan="2"

12、 align="center" width="50%" height="25">=4= </td></tr></tbody></table>,感謝你的辛勤工作。準(zhǔn)備待發(fā)送的數(shù)據(jù)：a.) 打開Excel，新建Book1.xlsxb.) 填入下面的內(nèi)容，第一列：接收人，第二列：郵件標(biāo)題，第三列：正文，第四列：附件路徑注意：附件路徑中可以有中文，但是不能有空格這里你可以寫更多內(nèi)容，每一行作為一封郵件發(fā)出。注意：郵件正文是黑白文本內(nèi)容，不支持加粗、字體顏色等。（如果你需要支持彩色的郵件，后

13、面將會給出解決辦法）2. 編寫宏發(fā)送郵件a.) Alt + F11 打開宏編輯器，菜單中選：插入->模塊b.) 將下面的代碼粘貼到模塊代碼編輯器中：代碼list-1vb view plaincopyprint?1. Public Declare Function SetTimer Lib "user32" _ 2. (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long 3. Public Declare Functio

14、n KillTimer Lib "user32" _ 4. (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long 5. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 6.7.8.9. Function WinProcA(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long 1

15、0. KillTimer 0, idEvent 11. DoEvents 12. Sleep 100 13. '使用Alt+S發(fā)送郵件，這是本文的關(guān)鍵之處，免安全提示自動發(fā)送郵件全靠它了 14. Application.SendKeys "%s" 15. End Function 16.17.18. ' 發(fā)送單個(gè)郵件的子程序 19. Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String) 2

16、0. Dim objOL As Object 21. Dim itmNewMail As Object 22. '引用Microsoft Outlook 對象 23. Set objOL = CreateObject("Outlook.Application") 24. Set itmNewMail = objOL.CreateItem(olMailItem) 25. With itmNewMail 26. .subject = subject '主旨 27. .body = body '正文本文 28. .To = to_who '收件者

17、29. .Attachments.Add attachement '附件，如果你不需要發(fā)送附件，可以把這一句刪掉即可，Excel中的第四列留空，不能刪哦 30. .Display '啟動Outlook發(fā)送窗口 31. SetTimer 0, 0, 0, AddressOf WinProcA 32. End With 33. Set objOL = Nothing 34. Set itmNewMail = Nothing 35. End Sub 36.37.38.39.40. '批量發(fā)送郵件 41. Sub BatchSendMail() 42. Dim rowCount

18、, endRowNo 43. endRowNo = Cells(1, 1).CurrentRegion.Rows.Count 44. '逐行發(fā)送郵件 45. For rowCount = 1 To endRowNo 46. SendMail Cells(rowCount, 1), Cells(rowCount, 2), Cells(rowCount, 3), Cells(rowCount, 4) 47. Next 48. End Sub Public Declare Function SetTimer Lib "user32" _ (ByVal hwnd As Lo

19、ng, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As LongPublic Declare Function KillTimer Lib "user32" _ (ByVal hwnd As Long, ByVal nIDEvent As Long) As LongPrivate Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Function WinProcA(ByVal

20、 hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long KillTimer 0, idEvent DoEvents Sleep 100 '使用Alt+S發(fā)送郵件，這是本文的關(guān)鍵之處，免安全提示自動發(fā)送郵件全靠它了 Application.SendKeys "%s"End Function' 發(fā)送單個(gè)郵件的子程序Sub SendMail(ByVal to_who As String, ByVal subject As String, ByV

21、al body As String, ByVal attachement As String) Dim objOL As Object Dim itmNewMail As Object '引用Microsoft Outlook 對象 Set objOL = CreateObject("Outlook.Application") Set itmNewMail = objOL.CreateItem(olMailItem) With itmNewMail .subject = subject '主旨 .body = body '正文本文 .To = to_

22、who '收件者 .Attachments.Add attachement '附件，如果你不需要發(fā)送附件，可以把這一句刪掉即可，Excel中的第四列留空，不能刪哦 .Display '啟動Outlook發(fā)送窗口 SetTimer 0, 0, 0, AddressOf WinProcA End With Set objOL = Nothing Set itmNewMail = NothingEnd Sub'批量發(fā)送郵件Sub BatchSendMail() Dim rowCount, endRowNo endRowNo = Cells(1, 1).CurrentR

23、egion.Rows.Count '逐行發(fā)送郵件 For rowCount = 1 To endRowNo SendMail Cells(rowCount, 1), Cells(rowCount, 2), Cells(rowCount, 3), Cells(rowCount, 4) NextEnd Sub最終代碼編輯器中的效果如下圖：i為了正確執(zhí)行代碼，你還需要在菜單中選擇： 工具->引用 中的Microseft Outlook X.0 Object Library 勾選上 （X.0是版本號，不同機(jī)器可能不一樣）c.) 粘貼好代碼、勾選上上面的東東后可以發(fā)送郵件了，點(diǎn)擊上圖A紅圈

24、所示的綠色三角按鈕，會彈出下圖所示的對話框，點(diǎn)運(yùn)行，就開始批量發(fā)送郵件了。d.) 如果你想確認(rèn)你的郵件是否都發(fā)出去了，可以去Outlook的“已發(fā)送郵件”文件夾中查看，是否有你希望發(fā)出的郵件，如果有，恭喜你，收工-下面講解1. 如何發(fā)送彩色的郵件2. 如何替換正文中的部分內(nèi)容，例如，每一封郵件中可能最開始的稱呼不同，給對方報(bào)出的數(shù)字不同等3. 如何發(fā)送多附件-1. 如何發(fā)送彩色郵件發(fā)送彩色郵件需要兩步，第一步：上面的代碼需要改一句（紅色加粗文本，body改成HTMLBody）：代碼list-2vb view plaincopyprint?1. ' 發(fā)送單個(gè)郵件的子程序 2. Sub S

25、endMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String) 3. Dim objOL As Object 4. Dim itmNewMail As Object 5. '引用Microsoft Outlook 對象 6. Set objOL = CreateObject("Outlook.Application") 7. Set itmNewMail = objOL.CreateItem(olMailItem)

26、8. With itmNewMail 9. .subject = subject '主旨 10. ' 11. .HTMLbody = body '正文本文，僅僅這一行跟前面不同，其余都是一樣的哦 12. ' 13. .To = to_who '收件者 14. .Attachments.Add attachement '附件 15. .Display '啟動Outlook發(fā)送窗口 16. SetTimer 0, 0, 0, AddressOf WinProcA 17. End With Set objOL = Nothing 18. Set

27、 itmNewMail = NothingEnd Sub ' 發(fā)送單個(gè)郵件的子程序Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String) Dim objOL As Object Dim itmNewMail As Object '引用Microsoft Outlook 對象 Set objOL = CreateObject("Outlook.Application") Set itmNewM

28、ail = objOL.CreateItem(olMailItem) With itmNewMail .subject = subject '主旨 ' .HTMLbody = body '正文本文，僅僅這一行跟前面不同，其余都是一樣的哦 ' .To = to_who '收件者 .Attachments.Add attachement '附件 .Display '啟動Outlook發(fā)送窗口 SetTimer 0, 0, 0, AddressOf WinProcA End With Set objOL = Nothing Set itmNew

29、Mail = NothingEnd Sub第二步：修改excel第三列（C列）的內(nèi)容，這需要你懂一點(diǎn)點(diǎn)HTML語言例如，希望在郵件中將“報(bào)稅單”三個(gè)字變紅，加粗，則將第三列的內(nèi)容修改為：您好，下面是這一周的<font color="red"><b>報(bào)稅單</b></font>，最終效果如圖：去發(fā)件箱里看看效果吧：注意：在Excel里面編輯正文，進(jìn)行加粗、加顏色的操作不會生效哦。必須用HTML自己來 2. 如何替換正文部分內(nèi)容分兩步：1. 換Excel內(nèi)容2. 換代碼1. 換Excel內(nèi)容：將變化的部分用=xxxx=這樣的形式替

30、換掉。注意：中間沒有空格。例如上圖，數(shù)字=1=會被E列的內(nèi)容替換掉，=2=會被F列的內(nèi)容替換掉，依此類推，如果有更多，就添加更多列，=3=, =4=等等。2. 換代碼，將 "批量發(fā)送郵件"這一段程序完全替換成下面的代碼：vb view plaincopyprint?1. '批量發(fā)送郵件 2. Sub BatchSendMail() 3. Dim rowCount, endRowNo 4. Dim newBody 5. Dim replaceCount, maxReplaceCount 6. Dim pattern 7. endRowNo = Cells(1, 1).

31、CurrentRegion.Rows.Count 8.9. '逐行發(fā)送郵件 10. For rowCount = 1 To endRowNo 11. ' 替換當(dāng)前行模板內(nèi)容 12. maxReplaceCount = 2 ' 有幾處替換就寫幾，例子中有兩處，就寫2 13. newBody = Cells(rowCount, 3) 14.15. For replaceCount = 1 To maxReplaceCount 16. pattern = "=" & CStr(replaceCount) & "=" 17

32、. newBody = WorksheetFunction.Substitute(newBody, pattern, Cells(rowCount, 4 + replaceCount) 18. Next 19. ' 替換好了，發(fā)郵件咯！ 20. SendMail Cells(rowCount, 1), Cells(rowCount, 2), newBody, Cells(rowCount, 4) 21.22. Next 23. End Sub '批量發(fā)送郵件Sub BatchSendMail() Dim rowCount, endRowNo Dim newBody Dim re

33、placeCount, maxReplaceCount Dim pattern endRowNo = Cells(1, 1).CurrentRegion.Rows.Count '逐行發(fā)送郵件 For rowCount = 1 To endRowNo ' 替換當(dāng)前行模板內(nèi)容 maxReplaceCount = 2 ' 有幾處替換就寫幾，例子中有兩處，就寫2 newBody = Cells(rowCount, 3) For replaceCount = 1 To maxReplaceCount pattern = "=" & CStr(repla

34、ceCount) & "=" newBody = WorksheetFunction.Substitute(newBody, pattern, Cells(rowCount, 4 + replaceCount) Next ' 替換好了，發(fā)郵件咯！ SendMail Cells(rowCount, 1), Cells(rowCount, 2), newBody, Cells(rowCount, 4) NextEnd Sub注意：上面“maxReplaceCount = 2"這一行代碼，2需要改成你自己的值，替換幾個(gè)地方就寫幾（新添加了幾個(gè)列就寫幾）上

35、面添加了E、F兩列，就是2，如果你添加了3處替換（E、F、G列），就寫3.不過，對于需要重復(fù)替換的內(nèi)容，不需要添加新列，例如，大話西游在郵件中出現(xiàn)了兩次，可以重復(fù)使用=2=來代表。3. 如何發(fā)送多附件在實(shí)際應(yīng)用場景中可能需要發(fā)送多封附件，其實(shí)很簡單，將SendMail子程序修改成下面的樣子即可：vb view plaincopyprint?1. ' 發(fā)送單個(gè)郵件的子程序 2. Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As S

36、tring) 3. Dim objOL As Object 4. Dim itmNewMail As Object 5. Dim attaches 6. Dim attach 7.8. '引用Microsoft Outlook 對象 9. Set objOL = CreateObject("Outlook.Application") 10. Set itmNewMail = objOL.CreateItem(olMailItem) 11. With itmNewMail 12. .subject = subject '主旨 13. .HTMLbody = b

37、ody '正文本文 14. .To = to_who '收件者 15. .Display '啟動Outlook發(fā)送窗口 16. attaches = Split(attachement, "") 17.18. For Each attach In attaches 19. If (Len(attach) > 0) Then 20. .Attachments.Add attach 21. End If 22. Next 23. SetTimer 0, 0, 0, AddressOf WinProcA 24. End With 25.26. Set

38、 objOL = Nothing 27. Set itmNewMail = Nothing 28. End Sub ' 發(fā)送單個(gè)郵件的子程序Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String) Dim objOL As Object Dim itmNewMail As Object Dim attaches Dim attach '引用Microsoft Outlook 對象 Set objOL = Crea

39、teObject("Outlook.Application") Set itmNewMail = objOL.CreateItem(olMailItem) With itmNewMail .subject = subject '主旨 .HTMLbody = body '正文本文 .To = to_who '收件者 .Display '啟動Outlook發(fā)送窗口 attaches = Split(attachement, "") For Each attach In attaches If (Len(attach) >

40、 0) Then .Attachments.Add attach End If Next SetTimer 0, 0, 0, AddressOf WinProcA End With Set objOL = Nothing Set itmNewMail = NothingEnd Sub在Excel的附件列（第三列），多個(gè)附件用半角的分號分隔開（是”;"，不是”；“），例如：c:doc畢業(yè)證書附件.jpg;c:doc校方證明書.docx最終代碼如下：匯總了批量替換、彩色郵件、多附件功能vb view plaincopyprint?1. Public Declare Function Se

41、tTimer Lib "user32" _ 2. (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long 3. Public Declare Function KillTimer Lib "user32" _ 4. (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long 5. Private Declare Sub Sleep Lib "kerne

42、l32" (ByVal dwMilliseconds As Long) 6.7.8.9.10. Function WinProcA(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long 11. KillTimer 0, idEvent 12. DoEvents 13. Sleep 100 14. '使用Alt+S發(fā)送郵件，這是本文的關(guān)鍵之處，免安全提示自動發(fā)送郵件全靠它了 15. Application.SendKeys "%s&qu

43、ot; 16. End Function 17.18.19. ' 發(fā)送單個(gè)郵件的子程序 20. Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String) 21. Dim objOL As Object 22. Dim itmNewMail As Object 23. Dim attaches 24. Dim attach 25.26. '引用Microsoft Outlook 對象 27. Set objOL =

44、 CreateObject("Outlook.Application") 28. Set itmNewMail = objOL.CreateItem(olMailItem) 29. With itmNewMail 30. .subject = subject '主旨 31. .HTMLbody = body '正文本文 32. .To = to_who '收件者 33. .Display '啟動Outlook發(fā)送窗口 34. attaches = Split(attachement, "") 35.36. For Each

45、 attach In attaches 37. If (Len(attach) > 0) Then 38. .Attachments.Add attach 39. End If 40. Next 41. SetTimer 0, 0, 0, AddressOf WinProcA 42. End With 43.44.45.46.47. Set objOL = Nothing 48. Set itmNewMail = Nothing 49. End Sub 50.51.52.53. '批量發(fā)送郵件 54. Sub BatchSendMail() 55. Dim rowCount, e

46、ndRowNo 56. Dim newBody 57. Dim replaceCount, maxReplaceCount 58. Dim pattern 59. endRowNo = Cells(1, 1).CurrentRegion.Rows.Count 60.61. '逐行發(fā)送郵件 62. For rowCount = 1 To endRowNo 63. ' 替換當(dāng)前行模板內(nèi)容 64. maxReplaceCount = 2 ' 有幾處替換就寫幾，例子中有兩處，就寫2 65. newBody = Cells(rowCount, 3) 66.67. For repl

47、aceCount = 1 To maxReplaceCount 68. pattern = "=" & CStr(replaceCount) & "=" 69. newBody = WorksheetFunction.Substitute(newBody, pattern, Cells(rowCount, 4 + replaceCount) 70. Next 71. ' 替換好了，發(fā)郵件咯！ 72. SendMail Cells(rowCount, 1), Cells(rowCount, 2), newBody, Cells(ro

48、wCount, 4) 73.74. Next 75. End SubPublic Declare Function SetTimer Lib "user32" _ (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As LongPublic Declare Function KillTimer Lib "user32" _ (ByVal hwnd As Long, ByVal nIDEvent As Long) As LongPrivate