[Ajuda] Vba criar pastas
Enviado: 21 Jan 2021 às 16:40
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
