本文共 2402 字,大约阅读时间需要 8 分钟。
在我们的工作环境中,使用了两种邮件客户端:外部邮箱(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
NewMailEx
事件处理,提取邮件的ID集合。Option Explicit
已设置。outApp
引用需手动添加,确保在References
中包含Outlook对象库。通过以上实现,我们可以自动处理Outlook收到的邮件,实现主题匹配后自动转发到Lotus Notes邮箱的功能,提升工作效率。
转载地址:http://iaffk.baihongyu.com/