Excel Criar sub-diretorios à partir de uma lista de diretorios

[daluque]

Boas.

Tenho uma planilha do excel com uma lista de diretórios.

Ex: C:\DiretorioDeCasos\Caso1...... até...... Caso1100

estou precisando criar dentro de cada pasta de "Caso" seis sub-pastas.(subcaso1, subcaso2, subcaso3, subcaso4, subcaso5, subcaso6)

Vi alguma coisa criando pastas dentro de uma pasta específica, mas á partir de uma lista de pastas não estou conseguindo implantar.

 

 

obrigado por ajudas.

 

 

[ricardo_br]

@daluque Pode compartilhar a planilha? Como você pretende fazer isso por VBA ou pode ser qualquer script?

[Midori]

@daluque Se o diretório for outro é só editar o argumento de GetFolder.

Sub CriaSubPastas()
    Dim Fso     As Object
    Dim Pasta   As Object
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
        
    For Each Pasta In Fso.GetFolder("C:\DiretorioDeCasos\").SubFolders
        If Left(Pasta.Name, Len("Caso1")) = "Caso1" Then
            Dim Novo    As String
            Dim I       As Integer
            For I = 1 To 6
                Novo = Pasta.Path & "\subcaso" & I
                If Not Fso.FolderExists(Novo) Then
                    Call Fso.CreateFolder(Novo)
                End If
            Next I
        End If
    Next Pasta
End Sub

 

Obs: A macro vai criar os subdiretórios em todas as pastas que começam com Caso1

[daluque]

Ola

minha estrutura esta conforme planilha anexa.

 

Midori, vou tentar usar seu código. Mas acho que não vai dar (apesar de o codigo ser ótimo)

porque no nomes diferem uns dos outros. os nomes colocados são só exemplos.

Estrutura para criar pastas.xls

[Midori]

@daluque Assim teria que fazer um loop na lista de diretórios da planilha em vez da forma que fiz com For Each. Mas se esse é só um exemplo e a quantidade vai de 1 até 1100 mesmo é melhor fazer um For de 1 até 1100.

[daluque]

Ok. Midori. obrigado

 

Você poderia me dar uma explicada de como seria esse processo ???

[Midori]

@daluque Pegando o caminho da planilha pode ser assim,

 

Sub CriaSubPastas()
    Dim Pasta   As Range
    For Each Pasta In [A6:A29]
        If Pasta <> "" Then
            If Dir(Pasta, vbDirectory) <> "" Then
                Dim Novo    As String
                Dim I       As Integer
                For I = 1 To 6
                    Novo = Pasta & "\NovaPasta" & I
                    If Dir(Novo, vbDirectory) = "" Then
                        Call MkDir(Novo)
                    End If
                Next I
            End If
        End If
    Next Pasta
End Sub

 

[daluque]

Ok. Midori, acredito que vá funcionar.

estou sem condições de testar no momento, amanhã farei o teste e dou um retorno.

 

muitíssimo obrigado

[ricardo_br]

Vou dar uma forma alternativa de como fazer isso usando um arquivo *.bat:

 

 

Aqui está o código:

 

@echo off

if exist "%~1" (if /i not "%~x1"==".csv" exit) else (exit)

set Subpasta=NovaPasta
set Quantidade=6

for /f "usebackq delims=;" %%a in ("%~1") do (
for /L %%b in (1,1,%Quantidade%) do If not exist "%%~a\%Subpasta%%%b" md "%%~a\%Subpasta%%%b"
                                             )

 

P.S: Um detalhe que notei é que algumas pastas em seu exemplo terminam com espaço ex: "AT-0005- ", no caso você não pode criar pastas que terminam com espaço parece que isso é contra a geração de nomes validos do Windows ou algo assim. Uma forma rápida de resolver isso é ir em Localizar & substituir e substituir "- " por "-"

[daluque]

Boas ricardo_br.

muito bom mesmo.

Só um detalhe: as subpastas não devem ser com o mesmo nome e numeradas, elas tem nomes específicos sobre ao que elas se referem. desculpe por fazer entender que as mesmas teriam nomes sequenciais.

 

os nomes devem ser por exemplo: Social/educação/juridico/documentos/psicologia/geral

 

mais uma vez desculpe pela confusão. 

 

mas muito obrigado pela colaboração.

[ricardo_br]

@daluque Basta modificar o código levemente:

 

@echo off

setLocal EnableDelayedExpansion
chcp 1252 >nul
if exist "%~1" (if /i not "%~x1"==".csv" exit) else (exit)

set Quantidade=6
set Subpasta[1]=Social
set Subpasta[2]=educação
set Subpasta[3]=juridico
set Subpasta[4]=documentos
set Subpasta[5]=psicologia
set Subpasta[6]=geral


for /f "usebackq delims=;" %%a in ("%~1") do (
for /L %%b in (1,1,%Quantidade%) do if /i not exist "%%a\!Subpasta[%%b]!" md "%%a\!Subpasta[%%b]!"
                                             )
exit

 

Se quiser usar acentos na criação das pastas como em "educação", quando for salvar o arquivo *.bat na parte onde tem a opção "Codificação" coloque ANSI...

[daluque]

ricardo_br  /  Midori

 

show.

muito obrigado pela ajuda. Simplesmente fantásticas soluções.