Este fórum está sendo desativado

[arthurvalenca]

Olá a todos estou batendo a cabeça aqui para criar um script que crie uma pasta raiz chamada "Save", logo após dentro da pasta Save crie outra pasta com o nome que estiver na coluna A1, apos criar essa crie outras pasta dentro da pasta que foi criada com o nome da coluna A1 chamada "info" e por fim salve a planilha aberta nessa pasta info com o nome da coluna A1, alguém poderia me ajudar com esse código?

OBS: As duas primeiras pastas que seria as duas primeira funções funcionam bem, mas a terceira e ultima nao funcionam.

Segue abaixo o que eu estou tentando fazer:

Código: Selecionar todos

Sub CriarPastas()

'Cria a pasta Raiz aonde esta a pasta de trabalho
     
    Dim raiz As Object, save
        Set raiz = CreateObject("Scripting.FileSystemObject")

            On Error Resume Next

                save = ThisWorkbook.Path & "\" & "Save"

    If Not raiz.folderexists(save) Then
            raiz.createFolder (save)
    End If
    
    
'Cria a pasta com o nome da celula A1 dentro da pasta Save
    
    Dim sub_p As Object, subPasta
        Set sub_p = CreateObject("Scripting.FileSystemObject")

            On Error Resume Next

                subPasta = save & "\" & Planilha1.Range("A1").Text

    If Not sub_p.folderexists(subPasta) Then
        sub_p.createFolder (subPasta)
    End If

'Cria uma pasta chamada info dentro da pasta criada com o nome da celula A1

    Dim sub_p1 As Object, subPasta1
        Set sub_p1 = CreateObject("Scripting.FileSystemObject")

            On Error Resume Next

                subPasta1 = save & "\" & subPasta1 & "\" & "info"

    If Not sub_p1.folderexists(subPasta1) Then
        sub_p1.createFolder (subPasta1)
    End If

'Salva em txt dentro da pasta info

    Dim Nome As String
    
     Nome = Planilha1.Range("A1").Text
     ActiveWorkbook.SaveAs Filename:=save & "\" & "subPasta" & "\" & subPasta1 & "\" & Nome & ".txt", _
     FileFormat:=xlUnicodeText, CreateBackup:=False


End Sub

[AfonsoMira]

Boas veja se é isto que deseja:

Código: Selecionar todos

Sub CriarPastas()

'Cria a pasta Raiz aonde esta a pasta de trabalho
     
    Dim raiz As Object, save
        Set raiz = CreateObject("Scripting.FileSystemObject")

            On Error Resume Next

                save = ThisWorkbook.Path & "\" & "Save"

    If Not raiz.folderexists(save) Then
            raiz.createFolder (save)
    End If
    
    
'Cria a pasta com o nome da celula A1 dentro da pasta Save
    
    Dim sub_p As Object, subPasta
        Set sub_p = CreateObject("Scripting.FileSystemObject")

            On Error Resume Next

                subPasta = save & "\" & ActiveSheet.Range("A1").Text

    If Not sub_p.folderexists(subPasta) Then
        sub_p.createFolder (subPasta)
    End If

'Cria uma pasta chamada info dentro da pasta criada com o nome da celula A1

    Dim sub_p1 As Object, subPasta1
        Set sub_p1 = CreateObject("Scripting.FileSystemObject")

            On Error Resume Next

                subPasta1 = subPasta & "\info"

    If Not sub_p1.folderexists(subPasta1) Then
        sub_p1.createFolder (subPasta1)
    End If

'Salva em txt dentro da pasta info

    Dim Nome As String
    
     Nome = ActiveSheet.Range("A1").Text
     ActiveWorkbook.SaveAs Filename:=subPasta1 & "\" & Nome & ".txt", _
     FileFormat:=xlUnicodeText, CreateBackup:=False

End Sub

[arthurvalenca]

@AfonsoMira, espetacular era isso mesmo que eu precisa