Excel VBA允许用户输入新的工作表名称

我有代码列出所选文件夹中的所有文件 . 现在它创建名为“Files”的新工作表 . 如何修改此代码，让用户每次单击按钮时输入文件夹名称？所以基本上情况看起来像这样：

• 点击按钮

• 选择要从中列出文件的文件夹

• 键入将列出文件的新工作表名称

• 已处理代码

• 点击按钮

• 选择要从中列出文件的文件夹

• 键入将列出文件的新工作表名称

• 已处理代码

• 同样的行动直到世界末日

我试过这个，但输入我的代码可能有错误：

Dim NewName As String 
NewName = InputBox("What Do you Want to Name the Sheet1 ?") 
Sheets("Sheet1").Name = NewName

我试图修改这个：

Sheets.Add.Name = NewName
        Sheets(NewName).[A1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)

我列出文件的代码和每个文件的完整路径：

Sub ListAllFilesInAllFolders()

    Dim MyPath As String, MyFolderName As String, MyFileName As String
    Dim i As Integer, F As Boolean
    Dim objShell As Object, objFolder As Object, AllFolders As Object, AllFiles As Object
    Dim MySheet As Worksheet

    On Error Resume Next

    '************************
    'Select folder
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "", 0, 0)
    If Not objFolder Is Nothing Then
        'MyPath = 
        MyPath = objFolder.self.Path & "\"
    Else
        Exit Sub

    End If
    Set objFolder = Nothing
    Set objShell = Nothing

    '************************
    'List all folders

    Set AllFolders = CreateObject("Scripting.Dictionary")
    Set AllFiles = CreateObject("Scripting.Dictionary")
    AllFolders.Add (MyPath), ""
    i = 0
    Do While i < AllFolders.Count
        Key = AllFolders.keys
        MyFolderName = Dir(Key(i), vbDirectory)
        Do While MyFolderName <> ""
            If MyFolderName <> "." And MyFolderName <> ".." Then
                If (GetAttr(Key(i) & MyFolderName) And vbDirectory) = vbDirectory Then
                    AllFolders.Add (Key(i) & MyFolderName & "\"), ""
                End If
            End If
            MyFolderName = Dir
        Loop
        i = i + 1
    Loop

    'List all files
    For Each Key In AllFolders.keys
        MyFileName = Dir(Key & "*.*")
        'MyFileName = Dir(Key & "*.PDF")    'only PDF files
        Do While MyFileName <> ""
            AllFiles.Add (Key & MyFileName), ""
            MyFileName = Dir
        Loop
    Next

    '************************
    'List all files in Files sheet

    For Each MySheet In ThisWorkbook.Worksheets
        If MySheet.Name = "Files" Then
            Sheets("Files").Cells.Delete
            F = True
            Exit For
        Else
            F = False
        End If
    Next
    If Not F Then Sheets.Add.Name = "Files"

    'Sheets("Files").[A1].Resize(AllFolders.Count, 1) = WorksheetFunction.Transpose(AllFolders.keys)
    Sheets("Files").[A1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
    Set AllFolders = Nothing
    Set AllFiles = Nothing
End Sub