Criando pastas e subpastas a partir dos valores das células do Excel

Question

Estou tentando criar um diretório denominado como o valor na coluna E em um diretório ( c:/Site Information ) e, em seguida, criar outro diretório chamado de valor concatenado da coluna A , B , C e D . Este valor é criado na coluna H da minha planilha.

Os diretórios criados C:/Site Information/value column E/Column H seriam o resultado.

Depois, estou tentando criar um hiperlink na coluna B para essa pasta e garantir que isso aconteça toda vez que um novo registro for adicionado às linhas subseqüentes.

Sou novo na VBS e queria saber se isso é possível. Além disso, se o diretório " value column E " já existir, eu preciso que o subdiretório seja criado neste diretório existente.

Qualquer ajuda seria apreciada.

Isso é tanto quanto minhas habilidades macro limitadas me permitiram ir.

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

Isso cria pastas na minha pasta pai. Isso é tudo tão longe.

Eu agora tentei simplificar a tarefa movendo os campos necessários para uma nova planilha e concatenando os campos necessários.

Eu então executo o seguinte 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

Quando executo isso, ele trabalha na planilha, criando um diretório com o nome da coluna 1 e, em seguida, uma subpasta com o nome da coluna 2.

Eu então tento copiar um conjunto de pastas predefinidas para essa pasta.

Interrompe FSO.CopyFolder Source:=FromPath, Destination:=ToPath com o caminho não encontrado ainda quando a depuração dos caminhos está presente.

Precisa superar esse obstáculo e tentar automatizar a criação do hiperlink.

Alguma idéia?

Caso alguém esteja interessado em colocar uma pausa no loop permitiu que o cmd time copiasse a pasta resolvendo o problema do caminho não encontrado.

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

Só quero gerar um hiperlink para cada pasta agora. Isso me deixou perplexo.

    

Answer 1

Verifique estes links link link

Acho que isso vai ajudar você.