Копирование VBA структуры папок outlook inbox в проводнике windows

Question

По какой-то причине он не заменяет запрещенные символы в windows остальное работает отлично, мой коллега и я не можем найти проблему, я довольно новичок в vba и узнал это сам для этой задачи , Любая помощь высоко ценится. Мы подозреваем, что бит не работает Function ReplaceInvalidCharacters внизу

Dim xFSO As Scripting.FileSystemObject
    Sub CopyOutlookFldStructureToWinExplorer()
        ExportAction "Copy"
    End Sub

    Sub ExportAction(xAction As String)
    Dim xFolder As Outlook.Folder
    Dim xFldPath As String
    xFldPath = SelectAFolder()
    If xFldPath = "" Then
        MsgBox "You did not select a folder. Export cancelled.", vbInformation + vbOKOnly, "Kutools for Outlook"
    Else
        Set xFSO = New Scripting.FileSystemObject
        Set xFolder = Outlook.Application.ActiveExplorer.CurrentFolder
        ExportOutlookFolder xFolder, xFldPath
    End If
    Set xFolder = Nothing
    Set xFSO = Nothing
    End Sub

    Sub ExportOutlookFolder(ByVal OutlookFolder As Outlook.Folder, xFldPath As String)
    Dim xSubFld As Outlook.Folder
    Dim xItem As Object
    Dim xPath As String
    Dim xFilePath As String
    Dim xSubject As String
    Dim xCount As Integer
    Dim xFilename As String
    On Error Resume Next
    xPath = xFldPath & "\" & OutlookFolder.Name
    '?????????,??????
    If Dir(xPath, 16) = Empty Then MkDir xPath
    For Each xItem In OutlookFolder.Items
        xSubject = ReplaceInvalidCharacters(xItem.Subject)
        xFilename = xSubject & ".msg"
        xCount = 0
        xFilePath = xPath & "\" & xFilename
        If xFSO.FileExists(xFilePath) Then
            xCount = xCount + 1
            xFilename = xSubject & " (" & xCount & ").msg"
            xFilePath = xPath & "\" & xFilename
        End If
        xItem.SaveAs xFilePath, olMSG
    Next
    For Each xSubFld In OutlookFolder.Folders
        ExportOutlookFolder xSubFld, xPath
    Next
    Set OutlookFolder = Nothing
    Set xItem = Nothing
    End Sub

    Function SelectAFolder() As String
    Dim xSelFolder As Object
    Dim xShell As Object
    On Error Resume Next
    Set xShell = CreateObject("Shell.Application")
    Set xSelFolder = xShell.BrowseForFolder(0, "Select a folder", 0, 0)
    If Not TypeName(xSelFolder) = "Nothing" Then
        SelectAFolder = xSelFolder.self.Path
    End If
    Set xSelFolder = Nothing
    Set xShell = Nothing
    End Function

    Function ReplaceInvalidCharacters(Str As String) As String
    Dim xRegEx
    Set xRegEx = CreateObject("vbscript.regexp")
    xRegEx.Global = True
    xRegEx.IgnoreCase = False
    xRegEx.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"
    ReplaceInvalidCharacters = xRegEx.Replace(Str, xRegEx.Pattern, "_")
    End Function