Outlook邮件自动转发处理脚本

背景与需求

在我们的工作环境中，使用了两种邮件客户端：外部邮箱（Outlook）和内部邮箱（Lotus Notes）。为了提高工作效率，我们希望在收到Outlook邮箱中的新邮件时，自动判断邮件的主题内容。如果邮件主题以“kkk:"开头，则将“kkk:"后面的内容提取出来，并将其作为收件人地址发送到Lotus Notes邮箱中。

解决方案

为了实现上述功能，我们可以使用微软Outlook的VBA宏编写一个自动化脚本。以下是实现该功能的详细代码和说明。

代码实现

Option ExplicitPublic WithEvents outApp As Outlook.ApplicationSub Initialize_handle()    Set outApp = ApplicationEnd Sub' 打开OutLook的时候调用，注册application引用Private Sub Application_Startup()    Initialize_handleEnd 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 = StringMid(EntryIDCollection, intInitial, (intLength - intInitial) + 1)    Set mai = Application.Session.GetItemFromID(strEntryID)    newmail_proc maiEnd SubPrivate 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 = StringMid(str_subject, 1, 4)    result = StringStrComp(str_kkk, "kkk:", vbTextCompare)        If result > 0 Then        str_reception = StringMid(str_subject, 5, (len_subject - 4) + 1)        str_body = mai.body        Set itm = outApp.CreateItem(0)        With itm            subject = "新邮件来自a@a.com"            to = str_reception            body = str_body            send        End With    End IfEnd Sub