定义文件夹位置

Question

处理 Outlook 2007 的宏，用于选择文件夹中的邮件。

在下面的示例 1 和 2 中选择了客户文件夹，然后选择了特定的客户文件夹。定义位置的方法似乎很笨拙。有没有更清洁的方法来做到这一点？

右键单击子文件夹并选择属性，显示的路径为：“\mailbox-name\customers\customer-xyz”。在宏中以这种方式引用路径是行不通的。是否可以更直接的方式引用文件夹位置？

Set olNamespace = olApp.GetNamespace("MAPI")

' Example-1, Select folder by name from default PST inbox
Set FolderKeep = _
 olNamespace.GetDefaultFolder(olFolderInbox).Folders("customers").Folders("customer-XYZ")

' Example-2, Select folder by mailbox name/folder/subfolder
Set FolderKeep = _
 olNamespace.Folders("mailbox-name").Folders("customers").Folders("customer-XYZ")

Answer 1

这里描述了一种将文件夹拉出路径的方法。

http://www.outlookcode.com/d/code/getfolder.htm

Private Function GetFolder(strFolderpath As String) As Folder

    ' The path argument needs to be in quotation marks and
    '  exactly match the folder hierarchy that the user sees in the Folder List.
    '
    ' NOTE: If any folder name in the path string contains a "\" character,
    '  this routine will not work,
    '
    ' As the developer do not use this. It hides errors.
    'On Error GoTo GetFolder_Error

    Dim objNS As Namespace
    Dim objFolder As Folder

    Dim arrFolders() As String

    Dim colFolders As Folders

    Dim i As Long

    Dim uErrorMsg As String

    ' Remove leading slashes, if any
    Do While Left(strFolderpath, 1) = "\"
        'Debug.Print strFolderpath
        strFolderpath = Right(strFolderpath, Len(strFolderpath) - 1)
    Loop

    Debug.Print strFolderpath

    arrFolders() = Split(strFolderpath, "\")

    Set objNS = 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

        Next

    End If

    Set GetFolder = objFolder

ExitRoutine:
    Set colFolders = Nothing
    Set objNS = Nothing
    Set objFolder = Nothing

    Exit Function

GetFolder_Error:
    uErrorMsg = "Err.Number: " & Err.Number & vbCr & "Err.Description: " & Err.Description
    MsgBox uErrorMsg
    Set GetFolder = Nothing
    Resume ExitRoutine

End Function

Private Sub GetFolder_Test()
    Dim testFolder As Folder
    Set testFolder = GetFolder("\mailbox-name\customers\customer-xyz")
    If Not (testFolder Is Nothing) Then testFolder.Display
End Sub