☰

Outlook VBA - 转到特定的公共文件夹而不提供完整的文件夹名称

tag-icon • tag-icon microsoft-outlook vba public-folders
Outlook VBA - 转到特定的公共文件夹而不提供完整的文件夹名称

我通常需要转到某些特定文件夹才能查看其中包含的电子邮件。这些文件夹位于 Outlook Exchange 公共文件夹中。我设法编写了一个脚本，我可以在弹出窗口中输入我需要转到的文件夹的全名，然后它会带我到那里。子文件夹名称的示例是

ELD/13/1746/22 - (ANT) - 印度贡嘎瓦拉姆加油站燃油分析

我想知道是否有办法只提供文件夹名称文件夹的第一部分（例如，在本例中为 ELD/13/1746/22），这样脚本就可以运行而无需输入完整的文件夹名称。注意：第一部分是参考编号，并且是唯一的，因此不可能有 2 个相同的。

我在此还给出我编写的脚本，并想知道是否可以使用某种通配符来完成文件夹的名称。

Sub PickFolder()
'Update by Extendoffice 20180504
Dim xNameSpace As NameSpace
Dim xPickFolder As folder
Dim xExplorer As Explorer
On Error Resume Next
Set xNameSpace = Outlook.Application.Session
Set xPickFolder = xNameSpace.PickFolder
If TypeName(xPickFolder) = "Nothing" Then Exit Sub
Set xExplorer = Outlook.Application.ActiveExplorer
xExplorer.Close
xPickFolder.Display
Outlook.Application.ActiveExplorer.WindowState = olMaximized
Set xPickFolder = Nothing
Set xNameSpace = Nothing
End Sub
Function GetFolder(ByVal FolderPath As String) As Outlook.folder
    Dim TestFolder As Outlook.folder
    Dim FoldersArray As Variant
    Dim i As Integer
 
    On Error GoTo GetFolder_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set TestFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not TestFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = TestFolder.Folders
            Set TestFolder = SubFolders.Item(FoldersArray(i))
            If TestFolder Is Nothing Then
                Set GetFolder = Nothing
            End If
        Next
    End If
     
   'Return the TestFolder
    Set GetFolder = TestFolder
    Exit Function
 
GetFolder_Error:
    Set GetFolder = Nothing
    Exit Function
End Function
 
Sub TestGetFolder()
    Dim folder As Outlook.folder
    Dim Refno
    Refno = InputBox(promt, "REF. No.")
    If Left(Refno, 3) = "RUB" Then
    Set folder = GetFolder("\\Public folders - [email protected]\all public folders\~technical-Purchasing\2.2 M/V RUBY -ex LADY AMNA\2.reqs\2022\" & Refno)
    ElseIf Left(Refno, 3) = "ELD" Then
    Set folder = GetFolder("\\Public folders - [email protected]\all public folders\~technical-Purchasing\2.3 Vessel name A\2.reqs\2022\" & Refno)
    ElseIf Left(Refno, 3) = "OMN" Then
    Set folder = GetFolder("\\Public folders - [email protected]\all public folders\~technical-Purchasing\2.4 Vessel name B\2.reqs\2022\" & Refno)
    ElseIf Left(Refno, 3) = "ELI" Then
    Set folder = GetFolder("\\Public folders - [email protected]\all public folders\~technical-Purchasing\2.5 Vessel name C\2.reqs\2022\" & Refno)
    ElseIf Left(Refno, 3) = "SIB" Then
    Set folder = GetFolder("\\Public folders - [email protected]\all public folders\~technical-Purchasing\2.6 Vessel name D\2.reqs\2022\" & Refno)
    ElseIf Left(Refno, 3) = "ZIM" Then
    Set folder = GetFolder("\\Public folders - [email protected]\all public folders\~technical-Purchasing\2.7 Vessel name E\2.reqs\2022\" & Refno)
    ElseIf Left(Refno, 3) = "EME" Then
    Set folder = GetFolder("\\Public folders - [email protected]\all public folders\~technical-Purchasing\2.8 Vessel name F\2.reqs\2022\" & Refno)
    ElseIf Left(Refno, 3) = "SID" Then
    Set folder = GetFolder("\\Public folders - [email protected]\all public folders\~technical-Purchasing\2.9 Vessel name G\2.reqs\2022\" & Refno)
    ElseIf Left(Refno, 3) = "SAN" Then
    Set folder = GetFolder("\\Public folders - [email protected]\all public folders\~technical-Purchasing\2.9 Vessel name H\2.reqs\2022\" & Refno)
    ElseIf Left(Refno, 3) = "MBL" Then
    Set folder = GetFolder("\\Public folders - [email protected]\all public folders\~technical-Purchasing\2.91 Vessel name I\2.reqs\2022\" & Refno)
    End If
    If Not (folder Is Nothing) Then
        folder.Display
    End If
    
End Sub

答案1

我建议使用For Each ... Next构造（对于每个...下一个)，使用以下函数测试文件夹名称Like：

For Each tmp In Application.GetNameSpace("MAPI").GetDefaultFolder(olFolderInbox).Folders
If tmp.Name Like TestValue & "*" Then
...
End If
Next tmp

你也可能喜欢这个Select Case结构（选择案例) 这样您只需获取一次 Refno 的左边 3 个字符。

相关内容