Question

我需要一个宏，它会将收到的邮件移到共享邮箱中，并移动到该邮箱的子文件夹，具体取决于发件人的电子邮件地址，基本上是正常的Outlook规则。

我一直在查看http://www.slipstick.com/上的一些文章，这些文章让我分道扬but，但是对于我想要做的事情没有一个确切的解决方案，而且我对Outlook中的VBA还不够熟练解决它。

到目前为止，我在ThisOutlookSession上有这个代码来观看邮箱：

Dim i As Long
Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  Set olInboxItems = GetFolderPath(">Digital Analytics\Inbox").Items
Set objNS = Nothing
End Sub

此功能在模块中获取被监视邮箱文件夹的路径：

' Use the GetFolderPath function to find a folder in non-default mailboxes
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer

    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function

GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function

Answer 1

这很有效，我使用了一个案例来移动项目，如果它来自特定的电子邮件地址：

Dim i As Long
Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  Set olInboxItems = GetFolderPath(">Digital Analytics\Inbox").Items
Set objNS = Nothing

    For Each Item In olInboxItems

End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

    Dim objDestFolder As Outlook.MAPIFolder
    Dim destFolder As String
    Dim sendersAddress As String

    If Item.Class = olMail Then

        sendersAddress = Item.SenderEmailAddress

        Select Case sendersAddress
            Case "no-reply@omniture.com"
                destFolder = ">Digital Analytics\Inbox\Reports"
            Case "no-reply@edigitalresearch.com"
                destFolder = ">Digital Analytics\Inbox\Reports"
        End Select

Set objDestFolder = GetFolderPath(destFolder)
    Item.Move objDestFolder
    End If

End Sub

共享邮箱管理

1 个答案: