MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Código para Backup Zipado

    Samuel Ribeiro
    Samuel Ribeiro
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 584
    Registrado : 05/02/2011

    [Resolvido]Código para Backup Zipado Empty [Resolvido]Código para Backup Zipado

    Mensagem  Samuel Ribeiro em 7/4/2015, 17:56

    Boa Tarde.

    Em busca de um código para fazer backup, copiei um criado pelo mestre JPaulo, faz tudo corretamente, ele cria o arquivo zipado na pasta onde direcionei, mas não copia o banco de dados, o arquivo fica vazio.
    Alguem sabe por que?
    Sera porque tem maquinas na rede ainda logado no banco de dados?
    Ou isto não tem nada a ver?

    Segue abixo o código como ficou.

    Código:
    Option Compare Database
    Option Explicit

    Public Sub ZipaBanco()
    Dim strDate As String, DefPath As String
    Dim oApp As Object
    Dim FName, FileNameZip As String
    Dim strPrefix As String
    On Error Resume Next

    'Caminho da pasta onde vai ser feito o backup
    DefPath = "D:\Sistema_Consulta_Produtos\Backup"
    If Right(DefPath, 1) <> "\" Then
    DefPath = DefPath & "\"
        End If
       
        strDate = Format(Now, "dd-mmm-yyyy_H-mm-ss")
        FileNameZip = DefPath & "Backup_" & strDate & ".Zip"
       
        strPrefix = "Pecas_Diseg_be.accdb"
       
        'Caminho do Back End
       
        FName = "D:\Sistema_Consulta_Produtos\" & strPrefix & ".accdb"
        On Error Resume Next
        CriaNovoZip (FileNameZip)
        Set oApp = CreateObject("Shell.Application")
        oApp.NameSpace(FileNameZip).CopyHere FName
        Call MsgBox("Backup Criado com Sucesso em: " & FileNameZip, vbInformation, "Criação de Backup Zipado")
        Set oApp = Nothing
       
        Exit Sub
       
    End Sub
    ----------------------------------------------------------------------------------------------------------------------------------------

    Public Sub CriaNovoZip(sPath)
        Dim ofso, arrHex, sBin, i, Zip
        On Error Resume Next
        Set ofso = CreateObject("Scripting.FileSystemObject")
        arrHex = Array(80, 75, 5, 6, 0, 0, 0, _
                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
        For i = 0 To UBound(arrHex)
            sBin = sBin & Chr(arrHex(i))
        Next
        On Error Resume Next
        With ofso.CreateTextFile(sPath, True)
            .Write sBin
            .Close
        End With
      Exit Sub
    End Sub


    Desde ja Agradeço.


    .................................................................................
    ______________________________
         Samuel Carlos Ribeiro
    Samuel Ribeiro
    Samuel Ribeiro
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 584
    Registrado : 05/02/2011

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  Samuel Ribeiro em 8/4/2015, 17:52

    Boa tarde

    Testei com as outras maquinas desligadas, e com o sisteama fechado
    Ficou do mesmo jeito, cria o arquivo zipado sem o banco de dados.

    Alguem sabe por que?


    .................................................................................
    ______________________________
         Samuel Carlos Ribeiro
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  ahteixeira em 8/4/2015, 18:27

    Olá, teste alterando a linha:
    strPrefix = "Pecas_Diseg_be.accdb"
    Para:
    strPrefix = "Pecas_Diseg_be"

    Abraço
    Samuel Ribeiro
    Samuel Ribeiro
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 584
    Registrado : 05/02/2011

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  Samuel Ribeiro em 8/4/2015, 18:54

    Boa tarde ahteixeira

    Muito Obrigado pelo retorno
    Modifiquei a linha conforme sua orientação, mas infelizmente nem o arquivo agora ele cria na pasta.


    .................................................................................
    ______________________________
         Samuel Carlos Ribeiro
    avatar
    NADIRONUNES
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 479
    Registrado : 30/08/2010

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  NADIRONUNES em 8/4/2015, 19:24

    e como faz pra zipar com senha
    Samuel Ribeiro
    Samuel Ribeiro
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 584
    Registrado : 05/02/2011

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  Samuel Ribeiro em 8/4/2015, 20:15

    Boa tarde NadirONunes

    Veja o link abaixo, um exemplo excelente criado pelo Piloto

    http://maximoaccess.forumeiros.com/t13490-restauracao-de-backup-com-desconexao-de-usuarios-logados-na-rede?highlight=Backup+de+bd+accdb


    .................................................................................
    ______________________________
         Samuel Carlos Ribeiro
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  ahteixeira em 8/4/2015, 22:39

    Olá,
    Descompacte para o disco c:\
    e teste o exemplo, depois é só alterar os caminhos e nome da base de dados.
    Abraço
    avatar
    NADIRONUNES
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 479
    Registrado : 30/08/2010

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  NADIRONUNES em 8/4/2015, 23:52

    ele nao zipa com senha, eu quero que ele faz um backup com senha
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  ahteixeira em 9/4/2015, 08:05

    Ola, com senha desconheço desta forma.
    Utilize winrar, 7zip.
    Com uma busca aqui no fórum tem exemplos como fazer.
    Abraço
    Samuel Ribeiro
    Samuel Ribeiro
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 584
    Registrado : 05/02/2011

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  Samuel Ribeiro em 9/4/2015, 13:02

    Bom dia ahteixeira

    Muito Obrigado pela atenção

    Copiei o script do exemplo que vc me mandou para um modulo que criei no meu próprio sistema do jeito que você me orientou alterando o código e adptando ao meu sistema.
    Criei um botão onde coloquei Fazer Backup, e na propriedade evento ao clica digitei "Call ZipaBanco"
    Ao acionar o botão Fazer Backup ele me da a mensagem de Backup criado com sucesso na pasta indicada e tudo mais.
    Só que não ta criando o arquivo na pasta.
    Veja como ficou o código novamente.

    Código:
    Option Compare Database
    Option Explicit


    Public Sub ZipaBanco()
    'JPaulo ? Maximo Access
    'http://maximoaccess.forumeiros.com/t16321-resolvidoenviar-arquivo-zipado-por-e-mail-no-mesmo-evento

    Dim strDate As String, DefPath As String
    Dim oApp As Object
    Dim FName, FileNameZip
    Dim strPrefix As String
    On Error Resume Next

        DefPath = Application.CurrentProject.Path & "\" & "Backup" 'Caminho da pasta onde esta o banco a zipar
        
        'verifica se existe pasta destino
        If Len(Dir(DefPath, vbDirectory) & "") = 0 Then
            MsgBox "Não existe caminho para backup: " & DefPath
            Exit Sub
        End If
        
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        strDate = Format(Now, "dd/mmmm/yyyy - hh:mm:ss")
        FileNameZip = DefPath & "Backup_" & strDate & ".zip"

        strPrefix = "Pecas_Diseg_be" 'Nome do banco que vai ser zipado


        'FName ? o caminho da pasta onde vai ficar o banco zipado.
        'neste exemplo vai ficar junto ao proprio banco
        'Se o seu Ms Access for anterior ao 2007,
        'deve alterar a exten??o de .accdb para .mdb
        FName = Application.CurrentProject.Path & "\" & strPrefix & ".accdb"

        'verifica se existe ficheiro
        If Len(Dir(FName) & "") = 0 Then
            MsgBox "Não existe o Banco de Dados: " & FName
            Exit Sub
        End If
     

        On Error Resume Next
        CriaNovoZip (FileNameZip)
        Set oApp = CreateObject("Shell.Application")
        oApp.NameSpace(FileNameZip).CopyHere FName
        MsgBox "Backup Criado com Sucesso em: " & FileNameZip
        Set oApp = Nothing
        Exit Sub
    End Sub


    Public Sub CriaNovoZip(sPath)
    'Criado pelo meu amigo e colega Raw do Canada
    'Adaptado por JPaulo ? Maximo Access
    Dim ofso, arrHex, sBin, i, Zip
    On Error Resume Next
    Set ofso = CreateObject("Scripting.FileSystemObject")
    arrHex = Array(80, 75, 5, 6, 0, 0, 0, _
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
    For i = 0 To UBound(arrHex)
    sBin = sBin & Chr(arrHex(i))
    Next
    On Error Resume Next
    With ofso.CreateTextFile(sPath, True)
    .Write sBin
    .Close
    End With
    Exit Sub
    End Sub

    Desde ja Agradeço


    .................................................................................
    ______________________________
         Samuel Carlos Ribeiro
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  ahteixeira em 9/4/2015, 14:34

    Olá,

    Para ajudar, será melhor dizer qual o erro para isso será necessário colocar a plica onde tiver:
    Código:
    On Error Resume Next
    colocar:
    Código:
    'On Error Resume Next

    Depois teste e em caso de erro tome nota do mesmo para reportar.
    Também necessitamos que informe:

    1) Indique o caminho completo e nome de ficheiro + extenção
     exemplo:   C:\MinhaPastaPrograma\MinhaBasedeDados.accdb

    2) Indique o caminho destino
    exemplo: D:\Backups\BaseDados

    Abraço
    Samuel Ribeiro
    Samuel Ribeiro
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 584
    Registrado : 05/02/2011

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  Samuel Ribeiro em 9/4/2015, 15:19

    Bom hteixeira

    o erro que apareceu é este:

    Erro em tempo de execução '91':
    A variavel do objeto ou a variavel do bloco 'whit' não foi definida.

    e esta linha aparece selecionada de amarelo:
    oApp.NameSpace(FileNameZip).CopyHere FName

    Não sei se faz diferença mas uso o aoffice 2013

    Caminho do banco de dados:
    D:\Sistema_Consulta_Produtos\Pecas_Diseg_be

    Caminho Destino:
    D:\Sistema_Consulta_Produtos\Backup

    No casa Backup é uma pasta

    Desde ja Agradeço


    .................................................................................
    ______________________________
         Samuel Carlos Ribeiro
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  ahteixeira em 9/4/2015, 15:56

    Olá Samuel,

    O meu exemplo testei em 2013 64 e windows 7 64 e está a funfar (nem é necessária nenhuma alteração).

    Agora diga-me, quando alterou o seguinte código o que aconteceu a seguir???

    Código:
    strDate = Format(Now, "dd/mmmm/yyyy - hh:mm:ss")

    Deve ter dado erro, acho que assim fica bem:
    Código:
    strDate = Format(Now, "yyyymmdd_hhmmss")

    O sistema não consegue criar ficheiros com : no nome

    Abraço
    Samuel Ribeiro
    Samuel Ribeiro
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 584
    Registrado : 05/02/2011

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  Samuel Ribeiro em 9/4/2015, 16:03

    Obrigado ahteixeira

    O Erro era aquele mesmo da data e da hora.

    Muito obrigado funcionou


    .................................................................................
    ______________________________
         Samuel Carlos Ribeiro
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  ahteixeira em 9/4/2015, 16:34

    Olá Samuel, obrigado pelo retorno os utilizadores do fórum agradecem.
    Abraço
    crysostomo
    crysostomo
    VIP
    VIP

    Respeito às Regras 50%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1463
    Registrado : 23/01/2018

    [Resolvido]Código para Backup Zipado Empty Re: [Resolvido]Código para Backup Zipado

    Mensagem  crysostomo em 20/2/2020, 16:06

    Boa tarde. Mais nenhum dos dois tem senha, então a integridade a rouba dos dados pode ser feita


    .................................................................................
    Uma mão ajuda a outra.
    Feliz aquele que transfere o que sabe e aprende o que ensina.

      Data/hora atual: 1/12/2020, 14:57