Question

我对Outlook VBA中的编程完全不熟悉。基本上我需要一个可以激活的宏，它可以读取消息正文并查找30个MSID的列表。例如，如果在主体中找到ms \ mblack和ms \ jdoe2，它将存储找到的任何/所有MSID，并将该消息转发给那些MSID。

作为奖励，将该电子邮件移至特定文件夹以将其从我的收件箱中取出是很好的。

Answer 1

标记不起作用，因此下一个最佳方法是将其从搜索未解答的问题中删除。

Sub MSID_in_Body()

Dim objNS As Namespace
Dim currItem As mailItem
Dim fwdItem As mailItem
Dim i As Long
Dim j As Long
Dim fwdRecipients As Outlook.Recipients

Const maxSize = 30
Dim array_MSID_address(1 To maxSize, 1 To 2) As String

Set objNS = Application.GetNamespace("MAPI")

For i = 1 To maxSize
    array_MSID_address(i, 1) = "dummy"
    array_MSID_address(i, 2) = ""
Next

array_MSID_address(1, 1) = "ms\mblack"
array_MSID_address(1, 2) = "mblack@thisplace.com"
array_MSID_address(2, 1) = "ms\jdoe2"
array_MSID_address(2, 2) = "jdoe2@thisplace.com"

Set currItem = ActiveInspector.CurrentItem
Set fwdItem = currItem.Forward

Set fwdRecipients = fwdItem.Recipients

For i = 1 To maxSize
    If InStr(currItem.Body, array_MSID_address(i, 1)) > 0 Then
        fwdRecipients.Add array_MSID_address(i, 2)
    End If
Next

fwdItem.Display
fwdItem.Recipients.ResolveAll

currItem.Close olDiscard

currItem.Move objNS.GetDefaultFolder(olFolderInbox).Folders("particular folder")

Set currItem = Nothing
Set fwdItem = Nothing
Set fwdRecipients = Nothing
Set objNS = Nothing

End Sub

如果邮件包含字符串Outlook 2010，则转发邮件

1 个答案: