共有メールボックス管理

Question

送信メールのアドレス（基本的には通常のOutlookルール）に応じて、受信メールを共有メールボックスのサブフォルダに移動するマクロが必要です。

http://www.slipstick.com/の記事を見てきましたが、そこに私の道がありましたが、私がやりたいことに対して正確な解決策がなく、OutlookのVBAにまだ堪能ではありませんでる。

' 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 
End Sub 

とモジュールでこの機能：

は、これまでのところ私は、メールボックスを見て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 

    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