如何将InputBox生成的路径赋值给Outlook.Folder对象？

问题说明 #

我将网上找到的隐藏Outlook文件夹代码修改为取消隐藏版本，逻辑是通过InputBox收集目标文件夹的层级深度、各父文件夹名称及目标文件夹名，生成路径字符串来取消隐藏状态。
手动写死文件夹路径赋值给Outlook.Folder对象时运行正常，但用InputBox生成的字符串赋值时，出现Compile Error: Type mismatch（类型不匹配）错误，且已确认生成的字符串与手动输入完全一致。

原代码 #

Public Sub Test()

    Dim oFolder As Folder
    Dim oPA As Outlook.PropertyAccessor
    Dim PropName, Value, FolderType As String
    Dim TargetFolder As String
    Dim Lvl1 As String
    Dim Lvl2 As String
    Dim Lvl3 As String
    Dim Lvl4 As String
    Dim Lvl5 As String
    Dim FullName As String
    Dim Lvls As String
    
    Lvls = InputBox("How many levels deep are is the target folder?", "Unhide Folder")
    Select Case Lvls
        Case "1"
            Lvl1 = "Session.GetDefaultFolder(olFolder" & InputBox("Please enter the name of the first level (parent) folder", "Unhide Folder") & ")"
        Case "2"
            Lvl1 = "Session.GetDefaultFolder(olFolder" & InputBox("Please enter the name of the first level (parent) folder", "Unhide Folder") & ")"
            Lvl2 = ".Folders(""" & InputBox("Please enter the name of the SECOND level folder", "Unhide Folder") & """)"
        Case "3"
            Lvl1 = "Session.GetDefaultFolder(olFolder" & InputBox("Please enter the name of the first level (parent) folder", "Unhide Folder") & ")"
            Lvl2 = ".Folders(""" & InputBox("Please enter the name of the SECOND level folder", "Unhide Folder") & """)"
            Lvl3 = ".Folders(""" & InputBox("Please enter the name of the THIRD level folder", "Unhide Folder") & """)"
        Case "4"
            Lvl1 = "Session.GetDefaultFolder(olFolder" & InputBox("Please enter the name of the first level (parent) folder", "Unhide Folder") & ")"
            Lvl2 = ".Folders(""" & InputBox("Please enter the name of the SECOND level folder", "Unhide Folder") & """)"
            Lvl3 = ".Folders(""" & InputBox("Please enter the name of the THIRD level folder", "Unhide Folder") & """)"
            Lvl4 = ".Folders(""" & InputBox("Please enter the name of the FOURTH level folder", "Unhide Folder") & """)"
        Case "5"
            Lvl1 = "Session.GetDefaultFolder(olFolder" & InputBox("Please enter the name of the first level (parent) folder", "Unhide Folder") & ")"
            Lvl2 = ".Folders(""" & InputBox("Please enter the name of the SECOND level folder", "Unhide Folder") & """)"
            Lvl3 = ".Folders(""" & InputBox("Please enter the name of the THIRD level folder", "Unhide Folder") & """)"
            Lvl4 = ".Folders(""" & InputBox("Please enter the name of the FOURTH level folder", "Unhide Folder") & """)"
            Lvl5 = ".Folders(""" & InputBox("Please enter the name of the FIFTH level folder", "Unhide Folder") & """)"
        Case Else
                
    End Select

    TargetFolder = InputBox("Please enter the name of the folder that you would like to unhide", "Unhide Folder")

    PropName = "http://schemas.microsoft.com/mapi/proptag/0x10F4000B"
    Value = False
    
    FullName = Lvl1 & Lvl2 & Lvl3 & Lvl4 & Lvl5 & ".Folders(""" & TargetFolder & """)"
        
    Set oFolder = Session.GetDefaultFolder(olFolderInbox).Folders("[example]").Folders("[example]")        'This works great
    Set oFolder = FullName                                                                                 '... but this brings up an error
    Set oPA = oFolder.PropertyAccessor

    oPA.SetProperty PropName, Value
 
    Set oFolder = Nothing
    Set oPA = Nothing
End Sub

问题根源 #

VBA中无法直接将字符串形式的代码赋值给对象。FullName是字符串类型，而oFolder是Outlook.Folder对象类型，直接赋值必然导致类型不匹配。原代码试图通过拼接代码字符串来获取对象，但这种方式不符合VBA语法规则——字符串不会被自动解析为可执行代码并返回对象。

修正后的代码 #

Public Sub UnhideOutlookFolder()
    Dim oFolder As Outlook.Folder
    Dim oPA As Outlook.PropertyAccessor
    Dim PropName As String
    Dim Value As Boolean
    Dim TargetFolderName As String
    Dim levelCount As Integer
    Dim currentFolder As Outlook.Folder
    Dim levelName As String
    Dim i As Integer
    
    ' 获取层级深度并验证
    levelCount = Val(InputBox("请输入目标文件夹的层级深度？", "取消隐藏文件夹"))
    If levelCount < 1 Or levelCount > 5 Then
        MsgBox "请输入1-5之间的有效数字", vbExclamation
        Exit Sub
    End If
    
    ' 获取根文件夹并转换为对应Outlook常量
    levelName = InputBox("请输入第一级（根）文件夹的名称（例如：Inbox、SentItems）", "取消隐藏文件夹")
    Select Case UCase(levelName)
        Case "INBOX": Set currentFolder = Session.GetDefaultFolder(olFolderInbox)
        Case "SENTITEMS": Set currentFolder = Session.GetDefaultFolder(olFolderSentMail)
        Case "DRAFTS": Set currentFolder = Session.GetDefaultFolder(olFolderDrafts)
        Case "DELETEDITEMS": Set currentFolder = Session.GetDefaultFolder(olFolderDeletedItems)
        Case "OUTBOX": Set currentFolder = Session.GetDefaultFolder(olFolderOutbox)
        Case Else
            MsgBox "不支持该根文件夹名称，请检查输入", vbExclamation
            Exit Sub
    End Select
    
    ' 逐层遍历获取父文件夹
    For i = 2 To levelCount
        levelName = InputBox("请输入第" & i & "级文件夹的名称", "取消隐藏文件夹")
        On Error Resume Next
        Set currentFolder = currentFolder.Folders(levelName)
        On Error GoTo 0
        If currentFolder Is Nothing Then
            MsgBox "找不到第" & i & "级文件夹：" & levelName, vbCritical
            Exit Sub
        End If
    Next i
    
    ' 获取目标文件夹
    TargetFolderName = InputBox("请输入要取消隐藏的文件夹名称", "取消隐藏文件夹")
    On Error Resume Next
    Set oFolder = currentFolder.Folders(TargetFolderName)
    On Error GoTo 0
    If oFolder Is Nothing Then
        MsgBox "找不到目标文件夹：" & TargetFolderName, vbCritical
        Exit Sub
    End If
    
    ' 修改文件夹隐藏属性
    PropName = "http://schemas.microsoft.com/mapi/proptag/0x10F4000B"
    Value = False
    
    Set oPA = oFolder.PropertyAccessor
    oPA.SetProperty PropName, Value
    
    MsgBox "文件夹已成功取消隐藏", vbInformation
    
    ' 释放对象资源
    Set oFolder = Nothing
    Set oPA = Nothing
    Set currentFolder = Nothing
End Sub

修正要点 #

1. 直接操作对象：不再拼接代码字符串，而是逐层获取Outlook.Folder对象，从根目录开始逐步定位到目标文件夹，彻底避免类型不匹配问题。
2. 常量转换：将用户输入的根文件夹名称（如"Inbox"）转换为Outlook内置常量（如olFolderInbox），确保正确获取根目录。
3. 错误处理：增加文件夹不存在的判断逻辑，及时弹出提示并终止程序，避免运行时错误。
4. 代码简化：用循环替代重复的Select Case结构，代码更简洁易维护。

内容的提问来源于stack exchange，提问作者BearOfVeryLittleBrain