Página 1 de 2

Backup - Maestro

Enviado: 12 Set 2017, 12:46
por Maurício Bruno
Bom Dia!

Tenho um formulário de Backup que utilizei do seu exemplo e fiz algumas adaptações nele, entretanto, está funcionando normal, porém, estou enfrentando 03 problemas no meu projeto.

1º - O formulário não habilita a função 7-Zip, pois os computadores aqui na empresa não possuem Winrar, ai tive que mudar o compactador.
2º - O contador não chega a 100% e para apresentando uma Mensagem de Backup Concluído
3º - Apresentando Erro 5 e Erro 2467.

Será que há algo errado na adaptação do meu código?

Código: Selecionar todos

Option Compare Database
Dim Escala          As Single
Dim Evento          As Byte
Dim objfs           As Object
Dim DestinoNovo     As String
Dim intCont         As Integer
Dim strLocalCompactador  As String

Private Sub Form_Open(Cancel As Integer)
'----------------------------------------------------------------------------------
'Verifica a presença do programa 7-Zip
'Grava o caminho na variável strLocalCompactador para ser usado na chamada do programa
'-----------------------------------------------------------------------------------
If Len(Dir(Environ("PROGRAMFILES") & "\7-Zip\7z.exe") & "") > 0 Then
    strLocalCompactador = Environ("PROGRAMFILES")
ElseIf Len(Dir(Environ("PROGRAMFILES") & "\7-Zip\7z.exe") & "") > 0 Then
    strLocalCompactador = Environ("PROGRAMFILES")
Else
    Me!check_compactar.Enabled = False
End If
Me!txOrigem = fncOrigemBackup
Me!txDestino = fncDestinoBackup

'CARREGAR TITULO, SUBTITULO, EMPRESA E VERSÃO
Me.txt_cab_titulo = Nz(DLookup("[Título]", "[Tbl_DESENV_Cadastro_de_Formulários_Desenvolvedor]", "[Formulário]='" & FormName & "'"), "")
Me.txt_cab_subtitulo = Nz(DLookup("[Subtitulo]", "[Tbl_DESENV_Cadastro_de_Formulários_Desenvolvedor]", "[Formulário]='" & FormName & "'"), "")
Me.txt_cab_empresa = Nz(DLookup("[Empresa]", "[Tbl_DESENV_Cadastro_de_Formulários_Desenvolvedor]", "[Formulário]='" & FormName & "'"), "")

'CARREGAR A LEGENDA DO FORMULÁRIO
Me.Caption = Nz(DLookup("[Legenda]", "[Tbl_DESENV_Cadastro_de_Formulários_Desenvolvedor]", "[Formulário]='" & FormName & "'"), "")
End Sub

Private Sub Form_Timer()
'---------------------------------------------------------------------------
'Este código se encontra no evento timer para alimentar a barra de progresso
'---------------------------------------------------------------------------
On Error GoTo trataErro
Evento = Evento + 1
Select Case Evento
    Case 1
        '-------------------------------------------------------------------------
        'Desabilita os botões enquanto a cópia estiver sendo realizada
        'Divide a barra de progresso, que tem um comprimento de 16cm, em 8 pedaços
        '-------------------------------------------------------------------------
        Me!cx1.Visible = True
        Me!btFoco.SetFocus
        Me!btCaminho.Enabled = False
        Me!btIniciarBackup.Enabled = False
        Escala = (16.5 * 690) / 10
        Me!cx1.Width = Escala
        Me!txt_porcentagem.Caption = "2%"
    Case 2
        Set objfs = CreateObject("Scripting.FileSystemObject")
        Me!Status.Caption = "Verificando Base de Dados..."
        Me!cx1.Width = Escala * 2
        Me!txt_porcentagem.Caption = "25%"
    Case 3
        Me!Status.Caption = "Copiando Base de Dados..."
        Me!cx1.Width = Escala * 3
        Me!txt_porcentagem.Caption = "40%"
    Case 4
        '----------------------------------------------------------------------------
        'Inicia o processo de cópia simples da base de dados para o destino indicado.
        'Aqui a barra de progresso fica parada até a cópia ser concluída
        '----------------------------------------------------------------------------
        objfs.CopyFile Me!txOrigem, Me!txDestino
    Case 5
        '----------------------------------------------
        'Após a conclusão da cópia o código prossegue
        '----------------------------------------------
        Me!Status.Caption = "Compactando Base de Dados..."
        Me!cx1.Width = Escala * 4
        Me!txt_porcentagem.Caption = "50%"
    Case 6
        Dim booResultado As Boolean
        '---------------------------------------------------------------------------------
        'Se a sua base de dados contiver uma senha de acesso, o método compactar e reparar
        'irá solicitá-la.
        '
        'A função do SendKeys é passar a senha no processo sem a intervenção do usuário.
        '
        'A função fncProtegido verifica se a base de dados possui senha e então permite
        'o uso do SendKeys.
        '
        'A função fncCapturSenha captura a senha informada na tabela tblCaminhoBe
        '---------------------------------------------------------------------------------
        If fncProtegido = True Then
            Dim objws As Object
            Set objws = CreateObject("wscript.shell")
           '-------------------------------------------------------------------------------------------
            'verifica se não há outro programa com o foco, como o word, excel ou o bloco de notas.
            'Enqunto o Access não tiver o foco, fica aguardando
            '------------------------------------------------------------------------------------------
            Do While GetFocus <> Me.hWnd
                Call Sleep(500) 'aguarda por meio segundo
                DoEvents '
            Loop
            '-------------------------------------------------------------------------------------------
            objws.SendKeys fncCapturaSenha, True
            objws.SendKeys "{ENTER}"
        End If
        Me!cx1.Width = Escala * 5
        Me!txt_porcentagem.Caption = "60%"
        '-----------------------------------------------------------------------
        'Observe que está sendo compactado e reparado a copia que foi gerada
        'pelo objfs.CopyFile no destino.
        '
        'É gerado então um outro arquivo, devidamente compactado e reparado, no
        'mesmo local de destino.
        '-----------------------------------------------------------------------
        DestinoNovo = Replace(Me!txDestino, "-", "-c")
        booResultado = Application.CompactRepair(Me!txDestino, DestinoNovo, True)
        '-----------------------------------------------------------------------------
        'O arquivo que foi copiado para o destino, pelo objfs.CopyFile, será excluído,
        'pois só nos interessa o que foi compactado e reparado.
        '-----------------------------------------------------------------------------
        If booResultado = True Then FileSystem.Kill Me!txDestino
        Set objws = Nothing
        Me!cx1.Width = Escala * 6
        Me!txt_porcentagem.Caption = "70%"
    Case 7
        '-------------------------------------------------
        'Executa o 7-Zip oculto se este tiver habilitado
        '--------------------------------------------------
        If Me!check_compactar = True Then
            Me!Status.Caption = "Compactando com o 7-Zip..."
            Dim compri
            compri = Shell(strLocalCompactador & "\7-Zip\7z.exe a " & Chr(34) & Replace(DestinoNovo, ".accdb", "") & ".zip" & Chr(34) & " " & Chr(34) & DestinoNovo & Chr(34), vbHide)
        End If
        Me!cx1.Width = Escala * 7
        Me!txt_porcentagem.Caption = "75%"
    Case 8
        If Me!check_compactar = True Then
        Me!cx1.Width = Escala * 8
        Me!txt_porcentagem.Caption = "80%"
            '--------------------------------------------------------------------------
            'Enquanto o 7-Zip não completar a tarefa de compactação, o comprimento
            'do arquivo gerado fica em zero. Verifico este comprimento com o FileLen.
            'A barra de progresso vai crescendo gradativamente enquanto o 7-Zip não
            'concluir a tarefa.
            '--------------------------------------------------------------------------
            If FileSystem.FileLen((Replace(DestinoNovo, ".accdb", "") & ".zip ")) = 0 Then
                Evento = 7
                If Me!cx1.Width < (11.2 * 690) Then intCont = intCont + 1
                Me!cx1.Width = (Escala * 9) + (15 * intCont)
                Me!txt_porcentagem.Caption = "90%"
            Else
                '----------------------------------------------------
                'Deleto o arquivo que não foi compactado pelo 7-Zip
                '----------------------------------------------------
                FileSystem.Kill DestinoNovo
                Me!Status.Caption = "Backup Concluído..."
                Screen.MousePointer = 0
                Me!cx1.Width = Escala * 10
                Me.TimerInterval = 3000
                Me!txt_porcentagem.Caption = "100%"
                MsgBox "Backup Concluído...", vbOKOnly + vbExclamation, "BACKUP"
            End If
        Else
            Me!Status.Caption = "Backup Concluído..."
            Screen.MousePointer = 0
            Me!cx1.Width = Escala * 10
            Me.TimerInterval = 3000
            Me!txt_porcentagem.Caption = "100%"
            MsgBox "Backup Concluído...", vbOKOnly + vbExclamation, "BACKUP"

        End If
    Case 9
        Set objfs = Nothing
        '-------------------------------------------------------------------------------------
        'Caso tenha ocorrido uma correção da base de dados, pelo método compactar e reparar
        'é gerado um arquilo de log.
        '
        'Então abre um comunicado, para chamada urgente do adminitrador, que deverá verificar
        'e corrigir a base de dados em uso.
        '-------------------------------------------------------------------------------------
        If Len(Dir(left(Me!txDestino, InStrRev(Me!txDestino, "\")) & "*.log", vbArchive) & "") > 0 Then
            MsgBox "Foi detectado problemas no arquivo de Backup." & vbCrLf & _
            vbCrLf & "Entre em contato imediatamente com o Desenvolvedor do Banco de Dados.", vbCritical, "Aviso"
        End If
        Me.TimerInterval = 0
        Evento = 0
End Select

sair:
    If Me.TimerInterval = 0 Then DoCmd.Close acDefault
    Exit Sub
trataErro:
    MsgBox err.Number & " - " & err.Description, vbInformation, "Aviso"
    Evento = 0: Screen.MousePointer = 0: Me.TimerInterval = 0
    Resume sair
End Sub


Agradeço a ajuda e atenção.

Re: Backup - Maestro

Enviado: 13 Set 2017, 17:49
por Avelino Sampaio
Mauricio

Eu não vou poder instalar aqui o 7-zip mas vamos tentar ajudar.

No evento "ao abrir" do formulário, tem as seguintes linhas:

Código:
...
If Len(Dir(Environ("ProgramFiles(x86)") & "\7-Zip\7z.exe") & "") > 0 Then
strLocalCompactador = Environ("ProgramFiles(x86)")
ElseIf Len(Dir(Environ("ProgramFiles") & "\7-Zip\7z.exe") & "") > 0 Then
strLocalCompactador = Environ("ProgramFiles")
Else
Me!check_compactar.Enabled = False
End If
msgbox strLocalCompactador
...


Acrescente a linha em vermelho, abra o formulário e me informe o que a caixa de mensagem retorna.

Aguardamos

Re: Backup - Maestro

Enviado: 13 Set 2017, 18:28
por Maurício Bruno
Avelino,

Aparece um Msgbox em branco.

Grato pelo retorno.

Re: Backup - Maestro

Enviado: 13 Set 2017, 18:51
por Avelino Sampaio
Mauricio

Qual é o seu Windows ? 10 ? 7 ? 32 ou 64 bits ?

acrescente mais essas duas e me diga o que retorna

...
If Len(Dir(Environ("ProgramFiles(x86)") & "\7-Zip\7z.exe") & "") > 0 Then
strLocalCompactador = Environ("ProgramFiles(x86)")
ElseIf Len(Dir(Environ("ProgramFiles") & "\7-Zip\7z.exe") & "") > 0 Then
strLocalCompactador = Environ("ProgramFiles")
Else
Me!check_compactar.Enabled = False
End If
msgbox Environ("ProgramFiles(x86)")
msgbox Environ("ProgramFiles")

...

Aguardamos

Re: Backup - Maestro

Enviado: 13 Set 2017, 19:09
por Maurício Bruno
Avelino,

Apareceu a mensagem: C:\Program Files (x86)

Grato,

Re: Backup - Maestro

Enviado: 13 Set 2017, 19:20
por Avelino Sampaio
Mauricio,

retire toda essa parte em vermelho

If Len(Dir(Environ("ProgramFiles(x86)") & "\7-Zip\7z.exe") & "") > 0 Then
strLocalCompactador = Environ("ProgramFiles(x86)")
ElseIf Len(Dir(Environ("ProgramFiles") & "\7-Zip\7z.exe") & "") > 0 Then
strLocalCompactador = Environ("ProgramFiles")
Else
Me!check_compactar.Enabled = False
End If


e substitua por essa:

strLocalCompactador="C:\Program Files (x86)"

ou por essa:

strLocalCompactador="C:\Program Files"

Verifique em que pasta esta seu 7z.exe

Aguardamos

Re: Backup - Maestro

Enviado: 13 Set 2017, 19:42
por Maurício Bruno
Avelino,

Agora a opção para compactar habilitou, no entanto, quando eu marco a opção para compactar ele não compacta o banco de dados (ZIP).

Grato,

Re: Backup - Maestro

Enviado: 13 Set 2017, 19:50
por Avelino Sampaio
Mauricio

No código do evento timer, acrecente a parte em vermelho e informe o que a caixa de mesagem apresenta:

Case 7
'-------------------------------------------------
'Executa o 7-Zip oculto se este tiver habilitado
'--------------------------------------------------
If Me!check_compactar = True Then
Me!Status.Caption = "Compactando com o 7-Zip..."
Dim compri
msgbox strLocalCompactador & "\7-Zip\7z.exe a " & Chr(34) & Replace(DestinoNovo, ".accdb", "") & ".zip" & Chr(34) & " " & Chr(34) & DestinoNovo & Chr(34)
compri = Shell(strLocalCompactador & "\7-Zip\7z.exe a " & Chr(34) & Replace(DestinoNovo, ".accdb", "") & ".zip" & Chr(34) & " " & Chr(34) & DestinoNovo & Chr(34), vbHide)
End If
Me!cx1.Width = Escala * 7
Me!txt_porcentagem.Caption = "75%"

Aguardamos

Re: Backup - Maestro

Enviado: 13 Set 2017, 20:01
por Maurício Bruno
Avelino,

Não apareceu mensagem nenhuma.

Grato,

Re: Backup - Maestro

Enviado: 13 Set 2017, 20:20
por Avelino Sampaio
Mauricio

Eu testei aqui e está indo até o ponto indicado. Observe na imagem que acrescentei com o mouse PONTOS DE INTERRUPÇÃO. O código vai parando nesses pontos para vc poder analisar valores e por onde ele está passando. Para liberar o código de um ponto para o outro, basta clicar na tecla F5. Observe que o código chegou aonde tem a tarja amarela. Quero que vc crie esses pontos, rode o backup e me diga se o código chegará no mesmo ponto.

Aguardamos

Re: Backup - Maestro

Enviado: 13 Set 2017, 21:06
por Maurício Bruno
Avelino,

O primeiro ponto de interrupção ele para e mostra uma senha, quando eu desmarco ele e peço para continuar ele fala que não há arquivo de saída.

Após desmarcar o ponto primeiro ponto de interrupção ele faz o backup, mais não chega ao segundo ponto de interrupção, na realidade o meu contador vai até 60% e salva o backup nem aparece o 100% e a msgbox.

Grato,

Re: Backup - Maestro

Enviado: 14 Set 2017, 18:00
por Maurício Bruno
Avelino,

Modifiquei varias vezes e não consegui solucionar o problema.

Grato,

Re: Backup - Maestro

Enviado: 14 Set 2017, 18:40
por Avelino Sampaio
Mauricio,

seu back-end possui senha ?

Aguardamos

Re: Backup - Maestro

Enviado: 14 Set 2017, 18:48
por Maurício Bruno
Avelino,

Possui sim.

Grato,

Re: Backup - Maestro

Enviado: 15 Set 2017, 19:39
por Maurício Bruno
Avelino,

O que percebi que o problema não e a senha, pois ele identifica a senha e faz o backup.
O problema esta após a senha, pois ele não identifica que a minha opção esta marcada compactar 7-zip e não compacta o arquivo.

Estou quebrando a cabeça aqui para achar uma solução. :D

Mesmo assim sou muito agradecido pela atenção, orientação e ajuda que está sendo prestada.

Re: Backup - Maestro

Enviado: 18 Set 2017, 14:14
por Maurício Bruno
Avelino,

O que você me sugere fazer neste caso?

Grato,

Re: Backup - Maestro

Enviado: 20 Set 2017, 14:36
por Avelino Sampaio
Mauricio,

o exemplo que forneceu vai normal aqui. Chega aos 70%, que é a posição aonde dá inicio a compactação. Usando o exemplo que vc forneceu, até que ponto o código prossegue ?

Aguardamos

Re: Backup - Maestro

Enviado: 20 Set 2017, 15:05
por Maurício Bruno
Avelino,

O meu chega até 60% fecha e aparece o backup na pasta normal sem a compactação.

Grato,

Re: Backup - Maestro

Enviado: 20 Set 2017, 15:22
por Avelino Sampaio
Mauricio

ponha uma caixa de texto na posição indicada

Código:
DestinoNovo = Replace(Me!txDestino, "-", "-c")
booResultado = Application.CompactRepair(Me!txDestino, DestinoNovo, True)
'-----------------------------------------------------------------------------
'O arquivo que foi copiado para o destino, pelo objfs.CopyFile, será excluído,
'pois só nos interessa o que foi compactado e reparado.
'-----------------------------------------------------------------------------
msgbox booResultado
msgbox Me!txDestino
msgbox DestinoNovo

If booResultado = True Then FileSystem.Kill Me!txDestino
Set objws = Nothing
Me!cx1.Width = Escala * 6
Me!txt_porcentagem.Caption = "70%"


Rode e informe os valores que as três caixas irão apresentar.

Aguardamos

Re: Backup - Maestro

Enviado: 20 Set 2017, 15:29
por Maurício Bruno
Avelino,

Não vou valor nenhum apresentado, nenhuma Msgbox apareceu.

Grato,

Re: Backup - Maestro

Enviado: 20 Set 2017, 15:57
por Avelino Sampaio
Ok

reposicione as caixas

Código:
DestinoNovo = Replace(Me!txDestino, "-", "-c")
msgbox booResultado
msgbox Me!txDestino
msgbox DestinoNovo

booResultado = Application.CompactRepair(Me!txDestino, DestinoNovo, True)
'-----------------------------------------------------------------------------
'O arquivo que foi copiado para o destino, pelo objfs.CopyFile, será excluído,
'pois só nos interessa o que foi compactado e reparado.
'-----------------------------------------------------------------------------

If booResultado = True Then FileSystem.Kill Me!txDestino
Set objws = Nothing
Me!cx1.Width = Escala * 6
Me!txt_porcentagem.Caption = "70%"


Aguardamos

Re: Backup - Maestro

Enviado: 20 Set 2017, 16:14
por Maurício Bruno
Avelino,

Chegou nos 60% e aparecer as msgbox abaixo:

1ª MsgBox (C:\Users\mauricio.bruno\Documentos\Maurício Bruno\Projetos\Projetos BD\backup\Projetos BD_BE20092017 - 130900.accdb)
2ª MsgBox (C:\Users\mauricio.bruno\Documentos -c\Maurício Bruno\Projetos\Projetos BD\backup\Projetos BD_BE20092017 - 130900.accdb)
3ª MsgBox (2285 - O Microsoft não pode criar o arquivo de saída)

Grato,

Re: Backup - Maestro

Enviado: 20 Set 2017, 16:23
por Avelino Sampaio
Mauricio

não percebeu aonde esta o erro ? veja nesta caixa, o endereço montado errado:

2ª MsgBox (C:\Users\mauricio.bruno\Documentos -c\Maurício Bruno\Projetos\Projetos BD\backup\Projetos BD_BE20092017 - 130900.accdb)

Aguardamos

Re: Backup - Maestro

Enviado: 20 Set 2017, 17:18
por Maurício Bruno
Avelino,

Mudei tudo até a pasta, mas mesmo assim apresenta o erro.
1ª MsgBox (C:\Users\mauricio\OneDrive - MBS\Documentos\Maurício\Projetos\Projetos BD\Backup\Projetos BD_BE20092017 - 111400.accdb)
2ª MsgBox (C:\Users\mauricio\OneDrive -c MBS\Documentos\Maurício\Projetos\Projetos BD\Backup\Projetos BD_BE20092017 - 111400.accdb)
3ª MsgBox (2285 - O Microsoft não pode criar o arquivo de saída)

Desculpe a minha falta de entendimento, pois alterei aqui de várias formar também o código e não funcionou.

Grato pela atenção e ajuda oferecida.

Re: Backup - Maestro

Enviado: 20 Set 2017, 17:51
por Avelino Sampaio
Mauricio

tira este traço(-) lá da pasta OneDrive-MBS. passe para OneDriveMBS

1ª MsgBox (C:\Users\mauricio\OneDrive - MBS\Documentos\Maurício\Projetos\Projetos BD\Backup\Projetos BD_BE20092017 - 111400.accdb)

Aguardamos