本文共 2455 字，大约阅读时间需要 8 分钟。

Outlook邮件自动转发处理脚本

背景与需求

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

解决方案

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

代码实现

Option Explicit
Public WithEvents outApp As Outlook.Application
Sub Initialize_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 = StringMid(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 = 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 If
End Sub

代码解释

实施步骤

注意事项

• 代码中outApp引用需手动添加，确保在References中包含Outlook对象库。
• 代码需放在正确的模块中，避免导致脚本无法运行。

通过以上实现，我们可以自动处理Outlook收到的邮件，实现主题匹配后自动转发到Lotus Notes邮箱的功能，提升工作效率。

转载地址：http://iaffk.baihongyu.com/