MSFT Outlook VBA处理新邮件的方法

shirobert

　　俺们有两个邮箱，1个外部的邮箱1（outlook），1个内部邮箱0（lotus notes）。想要outlook邮箱收到新邮件之后判断一下subject的内容，如果是"kkk:"开头，则将"kkk:"后面的内容作为to发到lotus notes的邮箱里面去。
　　测试环境（xp＋msft outlook），按alt+F11进入VBA编辑。注意要在工具 -> 宏 -> 安全性中设置为低。部分代码如下（手抄的，可能有错哦～～）：
　　option explicit
　　public WithEvents outApp as Outlook.Application
　　
　　Sub Initialite_handle ()
　　　　set outApp = Application
　　End Sub
　　
　　' 打开OutLook的时候调用，注册application引用
　　private sub Application_Startup ()
　　　　Initialize_handle
　　End Sub
　　'注意函数命名，收到新邮件的时候自动调用
　　Private sub outApp_NewMailEx (ByVal EntryIDCollection As String)
　　　　Dim mai As Object
　　　　Dim intInitial As Integer
　　　　Dim intFinal As Integer
　　　　Dim strEntry As String
　　　　Dim intLength As Integer
　　
　　　　intInitial - 1
　　　　intLength = Len(EntryIDCollection)
　　　　intFinal = InStr(intInitial, EntryIDCollection, ",")
　　　　Do While intFinal <> 0
　　　　　　strEntryID = Stringmid(EntryIDCollection, intInitial, (intFinal - intInitial))
　　　　　　set mai = Application.Session.GetItemFromID(strEntryID)
　　　　　　newmail_proc mai
　　　　　　intInitial = intFinal +1
　　　　　　intFinal = inStr(intInitial, EntryIDCollection, ",")
　　　　Loop
　　　　strEntryID = String.mid(EntryIDCollection, intInitial, (intLength - intInitial)+1)
　　　　set mai = Application.Session.GetItemFromID(strEntryID)
　　　　newmail_proc mai
　　End Sub
　　
　　private sub newmail_proc (ByVal mai As Object)
　　　　Dim itm As Object
　　　　Dim result As Integer
　　　　Dim str_kkk As String
　　　　Dim str_subject As String
　　　　Dim len_subject As Integer
　　　　Dim str_body As String
　　　　Dim str_reception As String
　　
　　　　str_subject = mai.subject
　　　　len_subject = Len(str_subject)
　　
　　　　str_kkk = String.mai(str_subject, 1, 4)
　　　　result = String.strComp(str_kkk, "kkk:", vbTextComare)
　　　　if result <> 0 then
　　　　Else
　　　　　　String_reception = String.mid(str_subject, 5, (len_subject-4)+1)
　　　　　　str_body = mai.body
　　　　　　set Itm = outApp.CreateItem(0)
　　　　　　with Itm
　　　　　　　　.subject = "new mail from a@a.com"
　　　　　　　　.to = str_reception
　　　　　　　　.body = str_body
　　　　　　　　.send
　　　　　　End With
　　　　End if
　　End Sub