MSFT Outlook VBA处理新邮件的方法

俺们有两个邮箱，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 [e-mail]"

.to = str_reception

.body = str_body

.send

End With

End if

End Sub