[Resolvido]Código para eliminar ficheiro, e pastas

Boa noite Amigos

Tenho este código para apagar todos os ficheiro e pastas que já tenham sido comprimido com WinRar.

Dúvida:

Como executar a mesma tarefa sem mencionar nome de ficheiro, ou nome de pastas ?

Obrigado  

'**************************************************

Sub ApagarPastaExistente()

'Apagar Pastas e Ficheiros
On Error Resume Next

Dim AFSO As Object

Dim FOL As String, FOL1 As String, FOL2 As String, FOL3 As String, FOL4 As String, FOL5 As String, FOL6 As String, FOL7 As String, FOL8 As String

FOL = CaminhoEscolhido & "Tabelas"
FOL1 = CaminhoEscolhido & "PDF"
FOL2 = CaminhoEscolhido & "Anteriores"
FOL3 = CaminhoEscolhido & "Icone"
FOL4 = CaminhoEscolhido & "Mails Recebidos"

FOL5 = CaminhoEscolhido & "\*.accd?"
FOL6 = CaminhoEscolhido & "\*.BMP"
FOL7 = CaminhoEscolhido & "\*.php"
FOL8 = CaminhoEscolhido & "\*.EXE"

Set AFSO = CreateObject("Scripting.FileSystemObject")

If AFSO.FolderExists(FOL, FOL1, FOL2, FOL3, FOL4, FOL5, FOL6, FOL7, FOL8) Then

AFSO.DeleteFolder FOL, True
AFSO.DeleteFolder FOL1, True
AFSO.DeleteFolder FOL2, True
AFSO.DeleteFolder FOL3, True
AFSO.DeleteFolder FOL4, True

AFSO.DeleteFile FOL5, True
AFSO.DeleteFile FOL6, True
AFSO.DeleteFile FOL7, True
AFSO.DeleteFile FOL8, True

Else
MsgBox FOL & " Não Existe ou Foi Apagada!", vbExclamation, "Aviso"
End If


End Sub

A solução segue a mesma lógica que já foi apresentada na ocasião abaixo
https://www.maximoaccess.com/t39461-resolvidocopiar-tudo-o-que-estiver-na-mesma-diretoria-da-base-de-dados#269023

Também vale lembrar que se você estiver usando o código da função que eu coloquei no repositório para zipar com o winrar, um dos parâmetros fala exatamente de apagar o arquivo original após ele ter sido zipado.

Public Sub fncZipaWinRAR(ByVal strOrigem As String, _
ByVal strDestino As String, _
Optional ByVal strSenha As String = "", _
Optional ByVal booEvitaAlteracao As Boolean = True, _
Optional ByVal booMantemOriginal As Boolean = False)

Bom dia

Testei assim e apaga até demais.

Apaga também, a a pasta criada .RAR

'*****************************************************

Sub ApagarPastaExistente()
Dim fso
Dim sfol As String, dfol As String
sfol = CurrentProject.Path
dfol = Me!CaminhoEscolhido
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
If Not fso.FolderExists(sfol) Then
MsgBox sfol & " Caminho Inválido.", vbInformation, "Aviso" '& DLookup("[Programa]", "Proprietario") & " " & DLookup("[Tipo]", "Proprietario")
ElseIf Not fso.FolderExists(dfol) Then
MsgBox dfol & " Caminho Inválido.", vbInformation, "Aviso" '& DLookup("[Programa]", "Proprietario") & " " & DLookup("[Tipo]", "Proprietario")
Else

fso.DeleteFolder dfol & "\*.*"
fso.DeleteFile dfol & "\*.*"
End If
If Err.Number = 53 Then MsgBox "Nada Agagado."

Código:

Dim objObjeto
Dim objFSO As Object
   
Set objFSO = CreateObject("Scripting.FileSystemObject")
   
For Each objObjeto In objFSO.GetFolder("C:\SuaPasta").SubFolders
    Call objFSO.DeleteFolder(objObjeto.Path)
Next objObjeto
   
For Each objObjeto In objFSO.GetFolder("C:\SuaPasta").Files
    If Not objObjeto.Name Like "*.rar" Then
        Call objFSO.DeleteFile(objObjeto.Path)
    End If
Next objObjeto
   
Set objFSO = Nothing

Bom dia Damasceno

O código funciona perfeito, mas tem um senão.

O local das cópias de segurança efetuadas em PenDrive nem sempre tem a mesma letra.
Veja as imagens



E o local é decidido neste formulário. Pode ser Gestão Condomínio, ou Gestão Bancos, pela letra da caixa de combinação .



Obrigado

Olá a todos,

Assis, acabou de dar a reposta, é só ajustar o código a "ir buscar ao campo" o caminho destino como mostra na foto


Uma recomendação facultativa e não obrigatória, evite acentuação em nomes de pastas, ficheiros e nomes de campos (um dia pode lembrar-se desta recomendação)

Abraço

Bom dia Teixeira

Já tentei e não funciona

Agradeço a recomendação. É fácil tirar a acentuação.

Mas não estou a ver como mudar o "C:\SuaPasta"

Obrigado

Olá a todos,

Assis o código sugerido foi este (não sei se está numa Sub ou Function), mas como disse olhando para a imagem é só ajustar, pois no seu form já está a mostrar o destino (unidade e caminho).
Ora se o código sugerido foi este:

Código:

Dim objObjeto
Dim objFSO As Object
    
Set objFSO = CreateObject("Scripting.FileSystemObject")
    
For Each objObjeto In objFSO.GetFolder("C:\SuaPasta").SubFolders
    Call objFSO.DeleteFolder(objObjeto.Path)
Next objObjeto
    
For Each objObjeto In objFSO.GetFolder("C:\SuaPasta").Files
    If Not objObjeto.Name Like "*.rar" Then
        Call objFSO.DeleteFile(objObjeto.Path)
    End If
Next objObjeto
    
Set objFSO = Nothing

Será algo assim:

Código:

Dim objObjeto
Dim objFSO As Object
dim strCaminho as string
strCaminho=Forms!NomeForm.NomeCampoQueMostraCaminho
    
Set objFSO = CreateObject("Scripting.FileSystemObject")
    
For Each objObjeto In objFSO.GetFolder(strCaminho).SubFolders
    Call objFSO.DeleteFolder(objObjeto.Path)
Next objObjeto
    
For Each objObjeto In objFSO.GetFolder(strCaminho).Files
    If Not objObjeto.Name Like "*.rar" Then
        Call objFSO.DeleteFile(objObjeto.Path)
    End If
Next objObjeto
    
Set objFSO = Nothing

Abraço

Obrigado Amigos

Um sistema de Backup adaptado para todas as minha bases de dados.

Obrigado Damasceno, pelo código

Obrigado Teixeira, pelo remate final

Olá a todos,

Assis, obrigado pelo feedback.
Fico feliz por ter conseguido, tem que ficar mais atento porque como pode confirmar foi fácil.

Abraço a todos