[Resolvido]Rotina criar Pasta e SubPasta

Boas,

Pessoal estou precisando criar uma rotina para a criação de subpasta, hoje já crio a pasta, mas por padrão da empresa preciso criar as subpastas no servidor. No BD utilizo a rotina abaixo:

Na criação desta pasta preciso criar mais as subpastas.

Documentos
Entrada_Saida
NC_Clientes
NC_Empresa
Pecas_Plasticas
Registos_Producao
Teste_Acido

Código:

On Error Resume Next
    Dim fso As Object
    Dim Pasta As String
    Dim numcrtl As String
    Dim nummld As String
    Dim nmclt As String
    Dim ext As String
    Dim Caminho As String
   
    numcrtl = Form_Documento_Controlo.Num_Doc_Controlo.Value
    nummld = Form_Documento_Controlo.NumeroMolde.Value
    nmclt = Form_Documento_Controlo.NomeCliente.Value
   
   
   
    Pasta = "\\2425FS01\Jobs\DB_Sis_Fabrico_em_teste\" & numcrtl & "-" & nummld & "-" & nmclt
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(Pasta) Then ' verifica se já existe a pasta
    Else
    MkDir Pasta ' se não existir cria
    End If

Desde já agradeço as ajudas que tenho até o momento.

Marcelo, Boa tarde!!

Obrigado pela ajuda, deu certo! E para excluir?

A rotina que utilizava para excluir sem as subpastas não está funcionando, criei a rotina abaixo e não funcionou.

Código:

Private Sub btn_excluir_Click()
 On Error Resume Next
   
    Dim Pasta As String
    Dim numcrtl As String
    Dim nummld As String
    Dim nmclt As String
    Dim a As String
    Dim b As String
    Dim c As String
    Dim d As String
    Dim e As String
    Dim f As String
    Dim g As String
   
    numcrtl = Form_Documento_Controlo.Num_Doc_Controlo.Value
    nummld = Form_Documento_Controlo.NumeroMolde.Value
    nmclt = Form_Documento_Controlo.NomeCliente.Value
    a = Pasta & "\Documentos" 'cria subpasta
    b = Pasta & "\Entrada_Saida" 'cria subpasta
    c = Pasta & "\NC_Cliente" 'cria subpasta
    d = Pasta & "\NC_Eschamman"
    e = Pasta & "\Pecas_Plasticas" 'cria subpasta
    f = Pasta & "\Registo_Producao" 'cria subpasta
    g = Pasta & "\Teste_Acido" 'cria subpasta
    Pasta = "\\2425FS01\Jobs\DB_Sis_Fabrico_em_teste\" & numcrtl & "-" & nummld & "-" & nmclt
   
    RmDir (a) 'Exclui pasta
    RmDir (b) 'Exclui pasta
    RmDir (c) 'Exclui pasta
    RmDir (d) 'Exclui pasta
    RmDir (e) 'Exclui pasta
    RmDir (f) 'Exclui pasta
    RmDir (g) 'Exclui pasta
    RmDir (Pasta) 'Exclui pasta

    If MsgBox("Este procedimento irá excluir este registro definitivamente ? ", vbYesNo + vbQuestion, "Aviso") = vbYes Then
    DoCmd.SetWarnings False
    DoCmd.RunCommand acCmdDeleteRecord
    DoCmd.SetWarnings True
    Else
    End If

 DoCmd.RunCommand acCmdRecordsGoToNew
 
End Sub

Para registro coloco a rotina que criei para as subpastas.

Código:

On Error Resume Next
    Dim fso As Object
    Dim Pasta As String
    Dim numcrtl As String
    Dim nummld As String
    Dim nmclt As String
    Dim ext As String
    Dim Caminho As String
    Dim a As String
    Dim b As String
    Dim c As String
    Dim d As String
    Dim e As String
    Dim f As String
    Dim g As String
   
   
    numcrtl = Form_Documento_Controlo.Num_Doc_Controlo.Value
    nummld = Form_Documento_Controlo.NumeroMolde.Value
    nmclt = Form_Documento_Controlo.NomeCliente.Value
   
   
   
    Pasta = "\\2425FS01\Jobs\DB_Sis_Fabrico_em_teste\" & numcrtl & "-" & nummld & "-" & nmclt
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(Pasta) Then ' verifica se já existe a pasta
    Else
    MkDir Pasta ' se não existir cria
    End If

    a = Pasta & "\Documentos" 'cria subpasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(a) Then ' verifica se já existe a pasta
    Else
    MkDir a ' se não existir cria
    End If

    b = Pasta & "\Entrada_Saida" 'cria subpasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(b) Then ' verifica se já existe a pasta
    Else
    MkDir b ' se não existir cria
    End If
   
    c = Pasta & "\NC_Cliente" 'cria subpasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(c) Then ' verifica se já existe a pasta
    Else
    MkDir c ' se não existir cria
    End If
   
    d = Pasta & "\NC_Eschamman"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(d) Then ' verifica se já existe a pasta
    Else
    MkDir d ' se não existir cria
    End If
   
    e = Pasta & "\Pecas_Plasticas" 'cria subpasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(e) Then ' verifica se já existe a pasta
    Else
    MkDir e ' se não existir cria
    End If
   
    f = Pasta & "\Registo_Producao" 'cria subpasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(f) Then ' verifica se já existe a pasta
    Else
    MkDir f ' se não existir cria
    End If
   
    g = Pasta & "\Teste_Acido" 'cria subpasta
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(g) Then ' verifica se já existe a pasta
    Else
    MkDir g ' se não existir cria
    End If


Obrigado a ajuda! Dou o tópico como resolvido, conseguir criar e agora não excluir.

Caso esse erro continue vou criar um novo tópico.

Mais uma vez obrigado à todos do Forum que contribui a evolução e ajuda a novatos.