Создание папок и вложенных папок из значений ячеек Excel

я пытаюсь создать каталог с именем в качестве значения в столбце E в папке (c:/Site Information), затем создайте еще один каталог, называемый объединенным значением столбца A,B,C и D. Это значение создается в столбце H в моем листе.

справочники, созданные C:/Site Information/value column E/Column H будет результат.

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

я новичок в VBS и хотел бы знать, если это возможно. Также если каталог"value column E " уже существует мне нужно, чтобы подкаталог был создан в этом существующем каталоге.

любая помощь будет оценили.

это насколько мои ограниченные макро навыки позволили мне пойти.

Sub Create_Folders()

'Parent folder.
ParentFolder = "C:Site Information"
'Create the folders from selected cells
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count

For c = 1 To maxCols
    r = 1
    Do While r <= maxRows
        If Len(Dir(ActiveWorkbook.Path & "" & Rng(r, c), vbDirectory)) = 0 Then
            MkDir (ParentFolder & "" & Rng(r, c))

            On Error Resume Next
        End If
        r = r + 1
    Loop

Next c
End Sub

это создает папки в моей родительской папке. Это все на данный момент.

я теперь попытался упростить задача путем перемещения обязательных полей на новый лист и объединения обязательных полей.

затем я запускаю следующий VBA

Private Sub CommandButton1_Click()
    For Each objRow In UsedRange.Rows
        strFolders = "C:Site Information"
        For Each objCell In objRow.Cells
            strFolders = strFolders & "" & objCell
            Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
        Next
        Dim FSO As Object
        Dim FromPath As String
        Dim ToPath As String
        FromPath = "C:Server Filing"  'predifined folders
        ToPath = strFolders     '<< created sub directory
        If FSO.FolderExists(FromPath) = False Then
            MsgBox FromPath & " doesn't exist"
            Exit Sub
        End If
        FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    Next
End Sub

когда я запускаю это, он работает вниз по листу, создавая каталог с именем столбца 1, а затем подпапку в этом имени столбца 2.

затем я пытаюсь скопировать набор предопределенных папок в эту папку.

останавливается на
FSO.CopyFolder Source:=FromPath, Destination:=ToPath
с путь не найден еще когда отладка путей присутствует.

нужно преодолеть это препятствие, а затем попытаться автоматизировать создание гиперссылки.

какие идеи?

в случае, если кто-то заинтересован положить паузу в цикле позволило cmd время, чтобы скопировать папку решения проблемы путь не найден.

Private Sub Createfolders_Click()
Sheets("Create Folders").Select
For Each objRow In UsedRange.Rows
    strFolders = "C:Site Information"
    For Each objcell In objRow.Cells
        strFolders = strFolders & "" & objcell
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next
    Dim FSO As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    Dim FromPath As String
    Dim ToPath As String
    FromPath = "C:Server Filing"  '------ Folder were pre defined folders are
    ToPath = strFolders     '<< Change------ Created sub folder
    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If
    If ToPath = "C:Site Information" Then
        MsgBox "Finished"
        Exit Sub
    End If
    If FSO.FolderExists(ToPath) = False Then
        Application.Wait (Now + #12:00:01 AM#)
        FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    End If
Next
End Sub

просто хочу создать гиперссылку на каждую папку сейчас. Это ставит меня в тупик.