使用動態路徑將電子郵件移動到公用文件夾

Question

在我們的企業環境中，我們有一個帶有許多子文件夾的郵箱（不是默認收件箱）。我們還有一個公用文件夾，它與郵箱文件夾結構完全相同。

我正在嘗試檢測選定電子郵件的路徑，並將該電子郵件移動到公用文件夾中的鏡像文件夾。

我會說95％的這段代碼是正確的，但我留下了一個Outlook錯誤信息「無法移動項目」。

的代碼應該執行以下步驟：
1.檢測所選擇的電子郵件（多個）
2.轉換MAPIFolder成路徑字符串
3的當前文件夾縮短串以除去根信箱目錄結構
4.添加剩餘的串到公用文件夾
5.轉換所得路徑的根目錄結構回一個MAPIFolder
6.移動所選擇的電子郵件（一個或多個），以在公共鏡像文件夾文件夾

Sub PublicFolderAutoArchive() 

    Dim olApp As Object 
    Dim currentNameSpace As NameSpace 
    Dim wipFolder As MAPIFolder 
    Dim objFolder As MAPIFolder 
    Dim pubFolder As String 
    Dim wipFolderString As String 
    Dim Messages As Selection 
    Dim itm As Object 
    Dim Msg As MailItem 
    Dim Proceed As VbMsgBoxResult 

    Set olApp = Application 
    Set currentNameSpace = olApp.GetNamespace("MAPI") 
    Set wipFolder = Application.ActiveExplorer.CurrentFolder 
    Set Messages = ActiveExplorer.Selection 

    ' Destination root directory' 
    ' Tried with both "\\Public Folders" and "Public Folders" .. neither worked 
    pubFolder = "\\Public Folders\All Public Folders\InboxMirror" 

    ' wipFolder.FolderPath Could be any folder in our mailbox such as: 
    ' "\\Mailbox - Corporate Account\Inbox\SubFolder1\SubFolder2" 
    ' however, the \\Mailbox - Corporate Account\Inbox\" part is 
    ' static and never changes so the variable below removes the static 
    ' section, then the remainder of the path is added onto the root 
    ' of the public folder path which is an exact mirror of the inbox. 
    ' This is to allow a dynamic Archive system where the destination 
    'path matches the source path except for the root directory. 
    wipFolderString = Right(wipFolder.FolderPath, Len(wipFolder.FolderPath) - 35) 

    ' tried with and without the & "\" ... neither worked 
    Set objFolder = GetFolder(pubFolder & wipFolderString & "\") 

    If Messages.Count = 0 Then 
     Exit Sub 
    End If 

    For Each itm In Messages 
     If itm.Class = olMail Then 
      Proceed = MsgBox("Are you sure you want archive the message to the Public Folder?", _ 
      vbYesNo + vbQuestion, "Confirm Archive") 
      If Proceed = vbYes Then 
       Set Msg = itm 
       Msg.Move objFolder 
      End If 
     End If 
    Next 
End Sub 

Public Function GetFolder(strFolderPath As String) As MAPIFolder 
    ' strFolderPath needs to be something like 
    ' "Public Folders\All Public Folders\Company\Sales" or 
    ' "Personal Folders\Inbox\My Folder" 

    Dim objApp As Outlook.Application 
    Dim objNS As Outlook.NameSpace 
    Dim colFolders As Outlook.Folders 
    Dim objFolder As Outlook.MAPIFolder 
    Dim arrFolders() As String 
    Dim I As Long 
    On Error Resume Next 

    strFolderPath = Replace(strFolderPath, "/", "\") 
    arrFolders() = Split(strFolderPath, "\") 
    Set objApp = Application 
    Set objNS = objApp.GetNamespace("MAPI") 
    Set objFolder = objNS.Folders.Item(arrFolders(0)) 
    If Not objFolder Is Nothing Then 
    For I = 1 To UBound(arrFolders) 
     Set colFolders = objFolder.Folders 
     Set objFolder = Nothing 
     Set objFolder = colFolders.Item(arrFolders(I)) 
     If objFolder Is Nothing Then 
     Exit For 
     End If 
    Next 
    End If 

Set GetFolder = objFolder 
Set colFolders = Nothing 
Set objNS = Nothing 
Set objApp = Nothing 
End Function 

注意：上面的郵箱只是一個示例，並不是實際的郵箱名稱。我使用MsgBox來確認路徑字符串與所有適當的反斜槓正確連接，並且Right（）函數正在從源路徑中獲取所需內容。

Answer 1

我不確定，但應該是這樣的？

set objApp = New Outlook.Application 

代替

set objApp = Application 

Answer 2

從代碼一眼，看來你GetFolder()實現不喜歡你在路徑的開始給予雙反斜線。在函數的開始部分甚至有評論指出這一點。嘗試從pubFolder的正面刪除這兩個字符。

或者，您可以更改GetFolder以允許它們。像這樣的幾行應該做的伎倆。

If Left(strFolderPath, 2) = "\\" Then 
    strFolderPath = Right(strFolderPath, Len(strFolderPath) - 2) 
End If