使用VBA进行电子邮件迁移的企业保管库的文件夹路径

Question

我有很长的文件夹列表以及许多使用标准规则管理器处理Outlook的规则。我编写的代码可以将项目分类并移动到文件夹，但最近我被迁移到了Enterprise Vault。我试图找到更新我的代码的文件夹路径。我试过类似的东西

Outlook.Application.GetNamespace("MAPI").Folders("Vault - DOE, JOHN").Folders("My Migrated PSTs").Folders("PR2018")

但老实说，我不知道正确的道路应该是什么。我在网上找到的所有内容都涉及从库中拉出选定的商品而不是将商品移入商店。以下是现有代码的摘录。这是在Office 365 / Outlook 2016上。

Sub Sort_Test(Item)
    Dim Msg As Object
    Dim Appt As Object
    Dim Meet As Object
    Dim olApp As Object
    Dim objNS As Object
    Dim targetFolder As Object

    On Error GoTo ErrorHandler

 Set Msg = Item
    Set PST = Outlook.Application.GetNamespace("MAPI").Folders("PR2018")
    checksub = Msg.Subject
    checksend = Msg.Sender
    checksendname = Msg.SenderName
    checksendemail = Msg.SenderEmailAddress
    checkbod = Msg.Body
    checkto = Msg.To
    checkbcc = Msg.BCC
    checkcc = Msg.CC
    checkcreation = Msg.CreationTime
    checksize = Msg.Size

'Classes Folder
        If checksub Like "*Files*Lindsey*" Or checksub Like "*Course Login*" _
        Or checksend Like "*Award*eBooks*" Then
                Set targetFolder = PST.Folders("Education").Folders("Classes")
                Msg.Move targetFolder
                GoTo ProgramExit
        End If

If targetFolder Is Nothing Then
        GoTo ProgramExit
'    Else
'        Msg.Move targetFolder
    End If

'    Set olApp = Nothing
'    Set objNS = Nothing
    Set targetFolder = Nothing
    Set checksub = Nothing
    Set checksend = Nothing


ProgramExit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

Answer 1

试试这段代码：

Sub MoveToFolder()

Dim olApp As New Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olArcFolder As Outlook.MAPIFolder
Dim olCompFolder As Outlook.MAPIFolder
Dim mailboxNameString As String
Dim myInspectors As Outlook.MailItem
Dim myCopiedInspectors As Outlook.MailItem
Dim myItem As Outlook.MailItem
Dim M As Integer
Dim iCount As Integer

Set olNameSpace = olApp.GetNamespace("MAPI")
Set olArcFolder = olNameSpace.Folders("Emails Stored on Computer").Folders("Archived")
Set olCompFolder = olNameSpace.Folders("Emails Stored on Computer").Folders("Computer")


For M = 1 To olArcFolder.items.Count
    Set myItem = olArcFolder.items(M)
    myItem.Display
    Set myInspectors = Outlook.Application.ActiveInspector.CurrentItem
    Set myCopiedInspectors = myInspectors.copy
    myCopiedInspectors.Move olCompFolder
    myInspectors.Close olDiscard
Next M

这是一个供您参考的链接：

Do for all open emails and move to a folder