Excel VBA позволяет пользователю вводить новое имя листа

Question

У меня есть код, чтобы перечислить все файлы в выбранной папке.Теперь он создает новый лист с именем «Файлы».Как изменить этот код, чтобы позволить пользователю вводить имя папки каждый раз, когда он нажимает кнопку?Таким образом, в основном сценарий будет выглядеть следующим образом:

1. Нажмите кнопку
2. Выберите папку для списка файлов из
3. Введите новое имя рабочего листа, где файлы будут перечислены
4. Код обработан
5. Нажмите кнопку
6. Выберите папку для списка файлов из
7. Введите новое имя рабочего листа, в котором будут перечислены файлы
8. Код обработан
9. Те же действия до конца света

Я пробовал это, но, вероятно, при вводе в мой код были ошибки:

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

Answer 1

Попробуйте использовать

With Sheets.Add
    .Name = NewName
    .Range("A1").Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
End With

Кроме того, не нужно зацикливаться, чтобы проверить, существует ли лист.Вместо этого используйте Обработка ошибок

Dim FilesSheet as Worksheet

On Error Resume Next
Set FilesSheet = Thisworkbook.Sheets("Files")
On Error GoTo 0

If Not FilesSheet is Nothing then
    F = True
    Set FilesSheet = ThisWorkbook.Sheets.Add
    FilesSheet.Name = NewName
Else
    F = False
    FilesSheet.Cells.Delete
End If

FilesSheet.Range("A1").Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)

Если вы создаете это для конечных пользователей, вы также можете захотеть встроить функциональность, чтобы убедиться, что вводимые ими значения NewName не слишком длинные (> 31 символа) дляИмя листа Excel и не содержит недопустимых символов ( \ / * [ ] : ? )