[Resolvido]Deletar pasta com subpastas e arquivos

Boas,

Mais uma vez venho recorrer aos mestres do Access e VBA.

No projeto, quando excluir o registro também quero excluir a  pasta. Já utilizava a rotina abaixo, porém depois que troquei a rotina para criar subpastas  e arquivos para dentro desta pasta a rotina parou de funcionar.

Código:


    Dim Pasta As String
    Dim numcrtl As String
    Dim nummld As String
    Dim nmclt 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
    
    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



Já tentei desta forma também e não obtive êxito.

Código:


    Dim Pasta As String
    Dim numcrtl As String
    Dim nummld As String
    Dim nmclt As String
    Dim fso As Object
    
     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
    
    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.DeleteFolder(Pasta) Then ' Deleta pasta pelo FSO
    Else
    RmDir Pasta ' Se não excluir via FSO deleta a pasta de forma forçada
    End If
    Set fso = Nothing


Cumprimentos.

Olá,

Olhando para o primeiro código da dúvida, verifique se a pasta está vazia.

Abraço

Bom dia!

A pasta não estará vazia, porque na criação eu crio subpastas e insiro fotos. Como a pasta será sequencial com o mesmo numero de documento preciso que ela seja deletada caso o registo seja deletado.

Resolvido!

Obrigado à todos!

O código abaixo.

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 fso As Object
   
   
    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.DeleteFolder(Pasta) Then ' Deleta pasta pelo FSO
    Else
    RmDir Pasta ' Se não excluir via FSO deleta a pasta de forma forçada
    End If
    Set fso = Nothing
 
    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


Cumprimentos

Bruno Nunes

Olá Bruno,

Obrigado por partilhar a solução, existe muitas formas de obter o resultado pretendido.

Continuando no exemplo 1 e caso algum membro tenha a mesma duvida...
Então como verificou era necessário estár a pasta vazia antes de chamar o RmDir

Para apagar a pasta (com base no seu exemplo) seria colocar assim antes da chmado do RmDir:

Código:

Kill Pasta &"\*.*"

Para dúvidas de como usar o "FSO" é só ver este exemplo desde 2010 do nosso grande JPaulo
https://www.maximoaccess.com/t913-fso-filesystemobject-para-manipularmos-arquivos

Abraço

ahteixeira, Agradeço, Pela dica do FSO e o Kill antes do RmDir.

Garanto que irei usar quando precisar novamente.

Abraços.

Pessoal Segue um código Recursivo que eu fiz:

Código:


Chamada da Função:

-- Irá apagar a pasta GERA_BQ e tudo que estiver dentro dela arquivos e directórios, usar com cuidado

Sub Chamar()
      ExcluirPastaRecursivamente("C:\Users\Fulano\Downloads\GERA_BQ")
end Sub

Public Sub ExcluirPastaRecursivamente(Caminho As String)
    Dim Arquivo As String

    ' Verifica se o caminho é válido
    If Dir(Caminho, vbDirectory) = "" Then
        MsgBox "Caminho inválido: " & Caminho, vbCritical, "Erro"
        Exit Sub
    End If

    ' Exclui arquivos na pasta
    Arquivo = Dir(Caminho & "\*.*")
    Do While Arquivo <> ""
        Kill Caminho & "\" & Arquivo
        Arquivo = Dir
    Loop

Exclui_SubPastas:

    Pasta = Dir(Caminho & "\*.*", vbDirectory)
    Do While Pasta <> ""
        If Pasta <> "." And Pasta <> ".." Then
            ExcluirPastaRecursivamente Caminho & "\" & Pasta
        End If
        On Error Resume Next
        Pasta = Dir
        If Err = 5 Then
           GoTo Exclui_SubPastas
        End If
    Loop

    ' Exclui a pasta principal
    RmDir Caminho
End Sub