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 a@a.com"

      .to = str_reception

      .body = str_body

      .send

    End With

  End if

End Sub

posted @ 2012-01-19 16:15  Nina  阅读(1218)  评论(0编辑  收藏  举报