Динамическое создание папок в VBA Excel

Question

У меня есть несколько файлов, которые необходимо распределить в соответствующие папки.Как проверить, существует ли папка с динамическим именем с помощью макроса Excel VBA?

Я разделил одну книгу на несколько по различным листам в ней.Я полагаю, что было бы проще, если бы макрос использовал имя каждого листа в оригинальной рабочей книге для проверки существования этой папки.Таким образом, он динамичен, и мне не нужно беспокоиться о его кодировании для поиска каждой папки, поскольку источник данных продолжает расти и нуждается в дополнительных рабочих листах.У меня уже есть код для поиска папки, мне просто нужно понять, как ее написать, чтобы она была динамической.

Dim Path As String
Dim Folder As String
Dim Answer As VbMsgBoxResult
Dim NewPath As String
NewPath = ActvieWorkbook.Sheets.Name
Path = "C:\Test" & NewPath
Folder = Dir(Path, vbDirectory)
For Each sheetz0r In ActiveWorkbook.Sheets
If Folder = vbNullString Then
    Answer = MsgBox("Path does not exist. Would you like to create it?", vbYesNo, "Create Path?")
    Select Case Answer
        Case vbYes
            VBA.FileSystem.MkDir (Path)
        Case Else
            Exit Sub
    End Select
End If
Next

В написанном мною коде мне просто нужна строка "NewPath ="настроен так, что он будет искать имена листов.

Answer 1

Переместите присваивания Path и Folder в теле цикла и замените & NewPath на & sheetz0r.Name - не уверен, каким должен быть ActiveSheet.Sheets.Name, класс коллекции Sheets не имеет Name участник.

Я бы немного перестроил вещи, удалил избыточные переменные и приблизил бы объявления к их использованию. Я думаю, что вы хотите сделать, это что-то вроде этого?

Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Worksheets

    Dim Path As String
    Path = Dir("C:\Test" & sheet.Name, vbDirectory)

    If Path = vbNullString Then
        If MsgBox("Path does not exist. Would you like to create it?", vbYesNo, "Create Path?") = vbYes Then
            VBA.FileSystem.MkDir Path
        Else
            Exit For
        End If
    End If
Next

Тем не менее, проверить, существует ли папка, и создать новую, намного проще / чище, используя FileSystemObject из библиотеки Scripting - я бы также абстрагировал подсказывающую часть в ее собственную функцию:

With New Scripting.FileSystemObject
    Dim sheet As Worksheet
    For Each sheet In ActiveWorkbook.Worksheets

        Dim Path As String
        Path = "C:\Test\" & sheet.Name

        If Not .FolderExists(Path) Then
            If ConfirmCreateFolder(Path) Then
                .CreateFolder Path
            Else
                Exit For
            End If
        End If

    Next
End With

Private Function ConfirmCreateFolder(ByVal Path As String) As Boolean
    Dim prompt As String
    prompt = "Folder '" & Path & "' does not exist. Would you like to create it?"
    ConfirmCreateFolder = (MsgBox(prompt, vbYesNo, "Create Folder?") = vbYes)            
End Function

Answer 2

Попробуйте это

Sub CheckFolder()
    Dim Path As String
    Dim Folder As String
    Dim Answer As VbMsgBoxResult
    Dim NewPath As String
    Dim scripObj As New Scripting.FileSystemObject


    Path = "C:\Test\"
    For Each sheetz0r In ActiveWorkbook.Sheets

    If Not scripObj.FolderExists(Path & sheetz0r.Name) Then
        Answer = MsgBox("Path does not exist. Would you like to create it?", vbYesNo, "Create Path?")
        Select Case Answer
            Case vbYes
                scripObj.CreateFolder (Path & sheetz0r.Name)
            Case Else
                Exit Sub
        End Select
    End If
    Next
End Sub