俺们有两个邮箱，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