excel vba文件名Namespace（）。CopyHere…and…Namespace（）。items出错

Question

难以获得多个解压缩才能使用自定义文件名。下面是代码，任何建议，不胜感激。尝试GetOpenFilename失败。错误发生的地方标记在下面：

Option Explicit
Sub UnzipSelectFiles()
    Dim xFileSelect As Variant
    Dim xSelectedItem As Variant
    Dim xFilePath As String
    Dim strDate As String
    Dim xFileNameFolder As Variant
    Dim xApp As Object

'    Set xFileSelect = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
    MultiSelect:=True)

    Set xFileSelect = Application.FileDialog(msoFileDialogOpen)

    With xFileSelect
        .AllowMultiSelect = True
        .Title = "Select ZIP Compressed Files"
        .Filters.Clear
        .Filters.Add "Zip Compressed Files", "*.zip"
        .InitialView = msoFileDialogViewDetails

        If xFileSelect.Show = -1 Then
            For Each xSelectedItem In xFileSelect.SelectedItems
                xFilePath = xSelectedItem
                strDate = Format(Now, " mmm-dd-yyyy hh_mm_ss AMPM")
                xFileNameFolder = xFilePath & strDate & "\"
                Debug.Print xFileNameFolder
                MkDir xFileNameFolder

                Set xApp = CreateObject("Shell.Application")

                '~~~~>
                'Runtime error #91 Object variable or with block variable not set
                xApp.Namespace(xFileNameFolder).CopyHere xApp.Namespace(xFileSelect).Items
                '~~~~>

                Next xSelectedItem
            End If
        End With
        Set xApp = Nothing
    End Sub