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