MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


3 participantes

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

    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4771
    Registrado : 06/11/2009

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

    Mensagem  Assis 18/4/2021, 21:08

    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


    .................................................................................
    *** Só sei que nada sei ***
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3845
    Registrado : 22/11/2016

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

    Mensagem  DamascenoJr. 19/4/2021, 03:11

    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)


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4771
    Registrado : 06/11/2009

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

    Mensagem  Assis 19/4/2021, 10:00

    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."



    .................................................................................
    *** Só sei que nada sei ***
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3845
    Registrado : 22/11/2016

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

    Mensagem  DamascenoJr. 20/4/2021, 00:04

    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


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.

    Assis gosta desta mensagem

    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4771
    Registrado : 06/11/2009

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

    Mensagem  Assis 20/4/2021, 11:57

    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

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

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

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

    Obrigado


    Última edição por Assis em 20/4/2021, 12:14, editado 1 vez(es)


    .................................................................................
    *** Só sei que nada sei ***
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

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

    Mensagem  Alvaro Teixeira 20/4/2021, 12:13

    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
    [Resolvido]Código para eliminar ficheiro, e pastas 0173

    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) Wink

    Abraço
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4771
    Registrado : 06/11/2009

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

    Mensagem  Assis 20/4/2021, 12:27

    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


    .................................................................................
    *** Só sei que nada sei ***
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

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

    Mensagem  Alvaro Teixeira 20/4/2021, 12:36

    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
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4771
    Registrado : 06/11/2009

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

    Mensagem  Assis 20/4/2021, 13:00

    Obrigado Amigos

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

    Obrigado Damasceno, pelo código Very Happy

    Obrigado Teixeira, pelo remate final cheers



    .................................................................................
    *** Só sei que nada sei ***
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

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

    Mensagem  Alvaro Teixeira 20/4/2021, 14:11

    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

    Conteúdo patrocinado


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

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 29/3/2024, 00:22