Создание папок и подпапок из значений ячеек Excel

Question

Я пытаюсь создать каталог с именем в качестве значения в столбце 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

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

Answer 1

Проверьте эти ссылки https://msdn.microsoft.com/en-us/library/aa242706%28v=vs.60%29.aspx https://msdn.microsoft.com/en-us/library/office/ff840672. ASPX

Я думаю, что это поможет вам.