當前位置：首頁 > 编程资源 > 编程问答 >内容正文

编程问答

outlook vba开发要点

發布時間：2024/4/13 编程问答 33 豆豆

生活随笔收集整理的這篇文章主要介紹了 outlook vba开发要点小編覺得挺不錯的,現在分享給大家,幫大家做個參考.

1.學學基礎的VB語法

https://www.yiibai.com/vba/vba_programming_charts.html

2.找一個樣例看看

VBA編程實現自動回復郵件

https://blog.csdn.net/tclxspy/article/details/50714783

3.改造樣例

取msdn上看看開發文檔

https://docs.microsoft.com/zh-cn/office/vba/outlook/concepts/getting-started/using-macros-to-customize-outlook

4.關鍵點

實現方式：COM，VBA

采用簡單的方式實現VBA。

5.坑

（1）導入庫

VBA編程提示編譯錯誤用戶定義類型未定義：需要找到自己引用的庫導入

Q：如何在VBA中添加對InternetExplorer對象的引用？
A：方法1：前期綁定：Alt+F11>VBE編輯環境>菜單欄>工具>引用>Microsoft Internet Controls

ie庫（internet controls），mshtml(microsoft html Object library),? microsoft xml library,? ?正則庫，microsoft? activeX庫，

（2）activex 部件不能創建對象

Set ie =CreateObject("InternetExplorer.Application")

ie.visible=true
ie.navigate "http://www.baidu.com"

提示: "運行時錯誤'429': ActiveX?部件不能創建對象??"...?或: "Run-time error '429' ActiveX componnent can't create object"...

a.設置工具--引用 microsoft ActiveX data objects 2.0 library

b.Internet選項 - 安全設置里，恢復為默認級別。

Internet選項 - 安全設置里面，可以自定義級別，只要確保ActiveX控件是啟用狀態。

(3)

6.開發技巧：

(1) alt + F11打開開發ide

(2) ctrl + g 打開立即窗口，調試信息輸出

(3) 視圖——>監視窗口，打開變量監控窗口

(4)單步調試 F8

7.VBA IE對象的操作方法

http://www.360doc.com/content/18/0223/17/52075843_731761102.shtml

https://blog.csdn.net/kendyhj9999/article/details/52267469?locationNum=4&fps=1

8.VBA面向對象

http://mini.eastday.com/mobile/170603152045489.html

demo1

'郵件自動轉發處理子程序 '功能：根據發件人過濾，讀取未讀郵件，轉發郵件 ' 'Sub AutoForward(rcvMail As Outlook.MailItem)'定義郵件轉發項目Dim myAutoForwardMailItem As Outlook.MailItemDim rcvhtmlBody As StringDim rcvBody As StringDim mto As StringDim ie, dmt, bd'定義郵件體Dim myAutoForwardHTMLBody As String'創建郵件體myForwardHTMLBody = CreateHTMLBody(2)If (rcvMail.UnRead) And (rcvMail.SenderEmailAddress = "942387T841U@qq.com") Or (rcvMail.SenderEmailAddress = "rdmod01@163.com") Or (rcvMail.SenderEmailAddress = "ju.li@163.com") Then'將郵件設為已讀rcvMail.UnRead = False'設置轉發器Set myAutoForwardMailItem = rcvMail.ReplyAll'設置收件人myAutoForwardMailItem.Recipients.Add "xx@qq.com"myAutoForwardMailItem.Recipients.Add "yy@qq.com"rcvhtmlBody = rcvMail.HTMLBodyrcvBody = rcvMail.Bodymto = rcvMail.ToDebug.Print ("htmlBody string: " & rcvhtmlBody)Debug.Print ("Body string: " & rcvBody)Debug.Print ("Recipients: " & mto)'處理郵件內容Set ie = CreateObject("InternetExplorer.Application")'設置郵件體格式為outlook html格式myAutoForwardMailItem.BodyFormat = olFormatHTML'將原始郵件與新郵件連起來myAutoForwardMailItem.HTMLBody = myForwardHTMLBody & myAutoForwardMailItem.HTMLBody'Displays a new Inspector object for the item.'myAutoForwardMailItem.Display'發送郵件'Sends the e-mail message.myAutoForwardMailItem.Send'原保存郵件'Saves the Microsoft Outlook item to the current folder or, if this is a new item, to the Outlook default folder for the item type.rcvMail.SaveEnd If'清空對象Set rcvMail = NothingSet myAutoReplyMailItem = Nothing End Sub Sub AutoForward1()Debug.Print ("xxx:" & RemoveHTML) End SubPublic Function CreateHTMLBody(id As Integer) As String'Creates a new e-mail item and modifies its propertiesDim objHTMLBody As String'可以設置多個模板If id = 1 ThenobjHTMLBody = _"<font face = 微軟雅黑 size = 3>" & _"感謝你的來信。我是<font color=red>機器人小星</font>，郵件我已代為閱讀。" & _"<br/> <br/> " & _"來自小星的智能轉發</font>"ElseIf id = 2 ThenobjHTMLBody = _"<table style = border-collapse:collapse <tbody>" & _"<tr><td style = border:1px solid #B0B0B0 colspan= 2>版本</td></tr>" & _"<tr><td style= border:1px solid #B0B0B0 >APP版本</td></tr>" & _"<tr><td style = border:1px solid #B0B0B0>SDK版本</td></tr>" & _"</tbody></table>" & _"" & _"<br/> <br/> " & _"來自小星的智能回復</font>"End IfCreateHTMLBody = objHTMLBody End FunctionSub test()Dim str As StringDim result As Stringstr = _"<table style = border-collapse:collapse <tbody>" & _"<tr><td style = border:1px solid #B0B0B0 colspan= 2>版本</td></tr>" & _"<tr><td style= border:1px solid #B0B0B0 >APP版本</td></tr>" & _"<tr><td style = border:1px solid #B0B0B0>SDK版本</td></tr>" & _"</tbody></table>" & _"" & _"<br/> <br/> " & _"來自小星的智能回復</font>"result = RemoveHTML(str)Debug.Print (result) End Sub'移除html標簽Public Function RemoveHTML(strText As String)Dim nPos1Dim nPos2Debug.Print ("Body string: ")nPos1 = InStr(strText, "<")Do While nPos1 > 0nPos2 = InStr(nPos1 + 1, strText, ">")If nPos2 > 0 ThenstrText = Left(strText, nPos1 - 1) & Mid(strText, nPos2 + 1)ElseExit DoEnd IfnPos1 = InStr(strText, "<")LoopRemoveHTML = strText End Function

demo2

Sub searchWebViaIE()Dim ie As SHDocVw.InternetExplorerDim doc As MSHTML.HTMLDocumentDim anchors As MSHTML.IHTMLElementCollectionDim anchor As MSHTML.HTMLAnchorElementDim prodSpec As MSHTML.HTMLAnchorElementDim tableCells As MSHTML.IHTMLElementCollectionDim materialValueElement As MSHTML.HTMLTableCellDim tableCell As MSHTML.HTMLTableCellSet ie = New SHDocVw.InternetExplorer'Set ie = CreateObject("InternetExplorer.Application")With ie.navigate "http://www.baidu.com".Visible = TrueDo While .readyState <> READYSTATE_COMPLETE Or .Busy = TrueDoEventsLoopSet doc = .documentSet anchors = doc.getElementsByTagName("a")For Each anchor In anchorsIf InStr(anchor.innerHTML, "Product Specificatie") <> 0 Thenanchor.ClickExit ForEnd IfNext anchorDo While .readyState <> READYSTATE_COMPLETE Or .Busy = TrueDoEventsLoopEnd WithFor Each anchor In anchorsIf InStr(anchor.innerHTML, "Product Specificatie") <> 0 ThenSet prodSpec = anchorEnd IfNext anchorSet tableCells = doc.getElementById("list-table").getElementsByTagName("td")If Not tableCells Is Nothing ThenFor Each tableCell In tableCellsIf tableCell.innerHTML = "Materiaal" ThenSet materialValueElement = tableCell.NextSiblingEnd IfNext tableCellEnd IfMsgBox materialValueElement.innerHTMLEnd Sub

　　demo3

'郵件自動轉發處理子程序 '功能：根據發件人過濾，讀取未讀郵件，轉發郵件 ' 'Sub AutoForward(rcvMail As Outlook.mailitem)'定義郵件轉發項目Dim myAutoForwardMailItem As Outlook.mailitemDim rcvhtmlBody As StringDim rcvBody As StringDim mto As String'Dim ie, dmt, bdDim sender As String'定義郵件體Dim myAutoForwardHTMLBody As StringDim ie As SHDocVw.InternetExplorerDim doc As MSHTML.HTMLDocument'創建郵件體myForwardHTMLBody = CreateHTMLBody(2)If (rcvMail.UnRead) And (rcvMail.SenderEmailAddress = "94s841@qq.com") Or (rcvMail.SenderEmailAddress = "rdmod01@163.com") Or (rcvMail.SenderEmailAddress = "ju.li@163.com") Then'將郵件設為已讀rcvMail.UnRead = False'設置轉發器Set myAutoForwardMailItem = rcvMail.ReplyAll'rcvMail.Attachments.item(1).SaveAsFile ("D:\")'設置收件人myAutoForwardMailItem.Recipients.Add "2s3016@qq.com"myAutoForwardMailItem.Recipients.Add "129s615@qq.com"rcvhtmlBody = rcvMail.HTMLBodyrcvBody = rcvMail.bodymto = rcvMail.ToDebug.Print ("htmlBody string: " & rcvhtmlBody)Debug.Print ("Body string: " & rcvBody)Debug.Print ("Recipients: " & mto)'處理郵件內容'Set ie = CreateObject("InternetExplorer.Application")'保存附件saveAttachments rcvMail'解析郵件主體resolveAttachSet ie = New SHDocVw.InternetExplorer'Set doc = .document'設置郵件體格式為outlook html格式myAutoForwardMailItem.BodyFormat = olFormatHTML'將原始郵件與新郵件連起來myAutoForwardMailItem.HTMLBody = myForwardHTMLBody & myAutoForwardMailItem.HTMLBody'Displays a new Inspector object for the item.'myAutoForwardMailItem.Display'發送郵件'Sends the e-mail message.myAutoForwardMailItem.Send'原保存郵件'Saves the Microsoft Outlook item to the current folder or, if this is a new item, to the Outlook default folder for the item type.rcvMail.SaveEnd If'清空對象Set rcvMail = NothingSet myAutoReplyMailItem = Nothing End SubSub saveAttachments(mailitem As Outlook.mailitem)Dim olAtt As AttachmentDim count: count = mailitem.attachments.countDim attachments: attachments = mailitem.attachmentsDim i: i = 0While i < counti = i + 1'附件索引從1開始Set olAtt = attachments(i)olAtt.SaveAsFile "D:\firefly\" & olAtt.FileNameWend End SubSub resolveAttach()Dim ie As SHDocVw.InternetExplorerDim doc As MSHTML.HTMLDocumentDim body As MSHTML.HTMLBodySet ie = New SHDocVw.InternetExplorerie.Visible = Falseie.navigate "D:\firefly\test.html"Do Until ie.readyState = 4 '檢查網頁是否加載完畢DoEvents '沒有加載完畢就將權限還給系統LoopSet doc = ie.documentSet body = doc.bodybody.End SubPublic Function CreateHTMLBody(id As Integer) As String'Creates a new e-mail item and modifies its propertiesDim objHTMLBody As String'可以設置多個模板If id = 1 ThenobjHTMLBody = _"<font face = 微軟雅黑 size = 3>" & _"感謝你的來信。我是<font color=red>機器人小星</font>，郵件我已代為閱讀。" & _"<br/> <br/> " & _"來自小星的智能轉發</font>"ElseIf id = 2 ThenobjHTMLBody = _"<table style = border-collapse:collapse <tbody>" & _"<tr><td style = border:1px solid #B0B0B0 colspan= 2>版本</td></tr>" & _"<tr><td style= border:1px solid #B0B0B0 >APP版本</td></tr>" & _"<tr><td style = border:1px solid #B0B0B0>SDK版本</td></tr>" & _"</tbody></table>" & _"" & _"<br/> <br/> " & _"來自小星的智能回復</font>"End IfCreateHTMLBody = objHTMLBody End FunctionSub test()Dim str As StringDim result As Stringstr = _"<table style = border-collapse:collapse <tbody>" & _"<tr><td style = border:1px solid #B0B0B0 colspan= 2>版本</td></tr>" & _"<tr><td style= border:1px solid #B0B0B0 >APP版本</td></tr>" & _"<tr><td style = border:1px solid #B0B0B0>SDK版本</td></tr>" & _"</tbody></table>" & _"" & _"<br/> <br/> " & _"來自小星的智能回復</font>"result = RemoveHTML(str)Debug.Print (result) End Sub'移除html標簽Public Function RemoveHTML(strText As String)Dim nPos1Dim nPos2Debug.Print ("Body string: ")nPos1 = InStr(strText, "<")Do While nPos1 > 0nPos2 = InStr(nPos1 + 1, strText, ">")If nPos2 > 0 ThenstrText = Left(strText, nPos1 - 1) & Mid(strText, nPos2 + 1)ElseExit DoEnd IfnPos1 = InStr(strText, "<")LoopRemoveHTML = strText End Function

''' '需求描述 '公司里面每天都會有很多郵件，三分之一都是不需要看的，Outlook的過濾功能不錯，都可以處理掉。還有些郵件，根據正文或者附件做一下處理自動轉發出去就行了。于是上網搜集了一些資料，寫個了小程序，共享一下，以后可以參考，也希望對大家有點用處。'實現 '廢話少說，直接上代碼吧。打開Outlook，按Alt+F11打開代碼編輯器，輸入下面的代碼。可能有些兄弟不知道怎么入手，后面會放幾個鏈接做參考。' '編輯完保存，在”開始->規則->創建規則”中添加一個過濾規則，在”如何處理該郵件”中選擇運行腳本，并選擇這個腳本。Sub AutoResponseReceipt(item As mailitem)Debug.Print ("receive an email")Dim id As StringDim SubjectString As StringDim sender As StringDim email As Outlook.mailitemOn Error GoTo Errid = item.EntryID ' 先獲取郵件的IDSet email = Application.Session.GetItemFromID(id)SubjectString = email.Subject ' 郵件主題sender = email.SenderEmailAddress ' 郵件的發送人地址Debug.Print ("new email arrivaved: subject is " & SubjectString & " sender is " & sender)Debug.Print ("new email arrivaved: subject is " & SubjectString & " recvs is " & email.Recipients)' 校驗主題，這里是對主題做過濾，不合適的直接返回不處理Dim index As Integerindex = InStr(SubjectString, "小票")If 0 = index Thenindex = InStr(SubjectString, "receipt")If 0 = index ThenReturnEnd IfEnd If' 下面這一段是我自己的一些處理邏輯，調用程序處理附件，' 然后將程序處理后的結果當做附件轉發給另一個人' 獲取附件并執行小票生成程序Dim PathPrefix As StringPathPrefix = "E:\document\receipt_tool\"Dim InputFileList As New Collection ' 這個列表存放收到的附件Dim OutputFileList As New Collection ' 存放程序生成的結果Dim AttachFile As Attachment ' 附件For Each AttachFile In email.attachments ' email.attachments是所有附件Debug.Print ("attachment: " & AttachFile.FileName)Dim InputFile As StringDim OutputFile As StringInputFile = PathPrefix & AttachFile.FileNameOutputFile = PathPrefix & AttachFile.FileName & ".docx"Debug.Print ("input file is " & InputFile)Debug.Print ("output file is " & OutputFile)AttachFile.SaveAsFile (InputFile) ' 保存附件Dim cmd As Stringcmd = """" & PathPrefix & "receipt.exe" & """" & " " & InputFile & " " & OutputFileDebug.Print ("command string: " & cmd)Shell (cmd) ' 執行腳本，生成結果InputFileList.Add (InputFile)OutputFileList.Add (OutputFile)'Kill (InputFile) ' 這里刪除的話總會把生成的文件同時刪掉NextIf OutputFileList.count = 0 ThenDebug.Print ("no attachment")End If' 轉發郵件Dim OutMail As ObjectSet OutMail = Outlook.Application.CreateItem(olMailItem)With OutMail.To = "hnwyllmm@126.com" ' 要轉發郵件的收件人地址.Subject = "打印：" & email.Subject ' 轉發郵件的主題.body = "幫忙打印小票，謝謝！" & Chr(10) & email.SenderEmailAddress & Chr(10) & email.SenderName ' 轉發郵件的正文End WithDim SendAttach As String ' 將程序生成的結果添加到附件中For i = 1 To OutputFileList.count ' MsgBox (SendAttach)SendAttach = OutputFileList(i)OutMail.attachments.Add (SendAttach)NextMsgBox ("send")OutMail.Send ' 發送郵件OutMail.Delete ' 刪除郵件，沒用了Err:' 刪除生成的文件For i = 1 To OutputFileList.countKill (OutputFileList(i))NextFor i = 1 To InputFileList.countKill (InputFileList(i))Nextemail.Delete ' 刪除收到的郵件' 下面幾個是釋放對象，其實沒有也無所謂Set InputFileList = NothingSet OutputFileList = NothingSet OutMail = NothingEnd Sub

Sub Command1_Click7()Dim str As StringDim li, cdDim c_name As String'遍歷元素<li>For Each li In Dom.document.getElementsByTagName("li")'用判斷忽略掉列首名稱的<li>行If li.classname = "lst_row" Then'遍歷<li>下的節點For Each cd In li.ChildNodes'判斷是否為元素節點If cd.NodeType <> 3 ThenIf cd.classname = "col_2" Then'如果是第2列的<span>,那么再用firstChild取出第一個元素節點<a>str = str & cd.FirstChild.href & " "Else'其他列直接輸出文本str = str & cd.innertext & " "End IfEnd IfNextstr = str & vbCrLfEnd IfNextPrint str End Sub

Sub ParseMaterial()Dim Cell As IntegerDim ItemNbr As StringDim AElement As ObjectDim AElements As IHTMLElementCollectionDim ie As MSXML2.XMLHTTP60Set ie = New MSXML2.XMLHTTP60Dim HTMLDoc As MSHTML.HTMLDocument Dim HTMLBody As MSHTML.HTMLBodySet HTMLDoc = New MSHTML.HTMLDocument Set HTMLBody = HTMLDoc.bodyFor Cell = 1 To 5 'I iterate through the file row by rowItemNbr = Cells(Cell, 3).Value 'ItemNbr isin the 3rd Column of my spreadsheetie.Open "GET", "http://www.example.com/?item=" & ItemNbr, Falseie.SendWhile ie.readyState <> 4DoEventsWendHTMLBody.innerHTML = ie.responseTextSet AElements = HTMLDoc.getElementById("list-table").getElementsByTagName("tr")For Each AElement In AElementsIf AElement.Title = "Material" ThenCells(Cell, 14) = AElement.NextNode.Value 'I write the material in the 14th columnEnd IfNext AElementApplication.Wait (Now + TimeValue("0:00:2"))Next Cell End Sub

<html><body><table width="400" border="1"><tr><th align="left">消費項目....</th><th align="right">一月</th><th align="right">二月</th></tr><tr><td align="left">衣服</td><td align="right">241.10</td><td align="right">50.20</td></tr><tr><td align="left">化妝品</td><td align="right">30.00</td><td align="right">44.45</td></tr><tr><td align="left">食物</td><td align="right">730.40</td><td align="right">650.00</td></tr><tr><th align="left">總計</th><th align="right">1001.50</th><th align="right">744.65</th></tr> </table><p>每個表格由 table 標簽開始。</p> <p>每個表格行由 tr 標簽開始。</p> <p>每個表格數據由 td 標簽開始。</p><h4>一列：</h4> <table border="1"> <tr><td>100</td> </tr> </table><h4>一行三列：</h4> <table border="1"> <tr><td>100</td><td>200</td><td>300</td> </tr> </table><h4>兩行三列：</h4> <table border="1"> <tr><td>100</td><td>200</td><td>300</td> </tr> <tr><td>400</td><td>500</td><td>600</td> </tr> </table> <table border="6"> <caption>我的標題</caption> <tr><td>100</td><td>200</td><td>300</td> </tr> <tr><td>400</td><td>500</td><td>600</td> </tr> </table><h4>Disc 項目符號列表：</h4> <ul type="disc"><li>蘋果</li><li>香蕉</li><li>檸檬</li><li>桔子</li> </ul> <h4>Circle 項目符號列表：</h4> <ul type="circle"><li>蘋果</li><li>香蕉</li><li>檸檬</li><li>桔子</li> </ul> <h4>Square 項目符號列表：</h4> <ul type="square"><li>蘋果</li><li>香蕉</li><li>檸檬</li><li>桔子</li> </ul> <h4>數字列表：</h4> <ol><li>蘋果</li><li>香蕉</li><li>檸檬</li><li>桔子</li> </ol> <h4>字母列表：</h4> <ol type="A"><li>蘋果</li><li>香蕉</li><li>檸檬</li><li>桔子</li> </ol> <h4>小寫字母列表：</h4> <ol type="a"><li>蘋果</li><li>香蕉</li><li>檸檬</li><li>桔子</li> </ol> <h4>羅馬字母列表：</h4> <ol type="I"><li>蘋果</li><li>香蕉</li><li>檸檬</li><li>桔子</li> </ol> <h4>小寫羅馬字母列表：</h4> <ol type="i"><li>蘋果</li><li>香蕉</li><li>檸檬</li><li>桔子</li> </ol> <h4>一個嵌套列表：</h4> <ul><li>咖啡</li><li>茶<ul><li>紅茶</li><li>綠茶</li></ul></li><li>牛奶</li> </ul></body> </html>

<!DOCTYPE html> <html> <head><title>test</title> </head> <body> <div> <ul class="lstbox"> <li class="lst_head"><span class="col_1">姓名</span><span class="col_2">郵箱</span><span class="col_3">生日</span></li><li class="lst_row"><span class="col_1">張三</span><span class="col_2"><a href="mailto:zhangsan@web.com" class="email">zhangsan</a></span><span class="col_3">80-5-1</span></li><li class="lst_row"><span class="col_1">李四</span><span class="col_2"><a href="mailto:lisi@web.com" class="email">lisi</a></span><span class="col_3">85-5-1</span></li><li class="lst_row"><span class="col_1">王五</span><span class="col_2"><a href="mailto:wangwu@web.com" class="email">wangwu</a></span><span class="col_3">90-5-1</span></li><li class="lst_row"><span class="col_1">趙六</span><span class="col_2"><a href="mailto:zhaoliu@web.com" class="email">zhaoliu</a></span><span class="col_3">95-5-1</span></li> </ul> </div> </body> </html>

將顯示名稱映射到電子郵件地址
https://docs.microsoft.com/zh-cn/office/vba/outlook/concepts/address-book/map-a-display-name-to-an-e-mail-address

獲取收件人的電子郵件地址
https://docs.microsoft.com/zh-cn/office/vba/outlook/concepts/address-book/obtain-the-e-mail-address-of-a-recipient

中文

https://msdn.microsoft.com/zh-cn/library/ee814736.aspx

?http://www.snb-vba.eu/VBA_Outlook_external_en.html#L_3.2.1

總結

以上是生活随笔為你收集整理的outlook vba开发要点的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。