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

2 participantes

    [Resolvido]Como fazer backup de Tabelas com senha?

    avatar
    LUCIEL-UDI
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 39
    Registrado : 19/12/2011

    [Resolvido]Como fazer backup de Tabelas com senha? Empty [Resolvido]Como fazer backup de Tabelas com senha?

    Mensagem  LUCIEL-UDI 12/9/2022, 08:23

    Olá amigos do Fórum!

    Vocês tem me ajudado muito indiretamente quando venho aqui pesquisar por uma solução de meus problemas, mas agora preciso de uma ajuda direta. Não sei se tem algo no Fórum, pesquisei mas não encontrei.

    Eu tenho um sistema Front-End / Back-End, onde as tabelas do Back estão com senha e no Front eu vinculei as tabelas com as senhas. Para ficar mais protegido, desabilitei a tecla SHIFT e Salvei uma cópia para a extesão ACCDE, assim nesta cópia protejo o VBA.

    O que eu preciso agora é o seguinte:

    Coloquei uma opção que todas as vezes que fecho o sistema, faço uma cópia do Back-End como backup. Só que não está dando certo pois as tabelas estão com senhas. Preciso que me ajudem a colocar um comando que eu consiga fazer cópias das tabelas com senha.

    Vou descrever abaixo o código VBA do backup das tabelas o Back-End:

    ------------------------------------------------
    Private Sub BtSair_Click()

    Dim CopiaSegura As Object
    Dim Caminho As String
    Dim DiaSemana As String

    DiaSemana = DatePart("w", Date) 'Faz uma cópia por dia, subscrevendo cada backup uma vez por semana

    Caminho = "G:\Meu Drive\BKP" & DiaSemana & ".accdb" 'Nome da pasta e nome de inicio para o banco de backup

    If MsgBox("SAIR DO SISTEMA?", vbQuestion + vbYesNo, "ATENÇÃO!") = vbYes Then
    Set CopiaSegura = CreateObject("Scripting.FileSystemObject")
    CopiaSegura.CopyFile "G:\Meu Drive\BDUSS.accdb", Caminho 'Faz cópia do Front End diariamente ao fechar o sistema
    DoCmd.Quit
    End If

    End Sub
    -------------------------------------------------

    Se puderem me ajudar ou dar uma ideia mais interessante eu agradeço muito!

    marcelo3092
    marcelo3092
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 277
    Registrado : 19/08/2010

    [Resolvido]Como fazer backup de Tabelas com senha? Empty Re: [Resolvido]Como fazer backup de Tabelas com senha?

    Mensagem  marcelo3092 13/9/2022, 18:47

    Boa noite teria como vc postar parte do seu projeto ou uma copia limpa para podermos te ajuda pois teria que ver como e a estrutura do seu projeto, e como e a senha pois o usandoaccess do avelino tem um backup para isso com back end com senha e tb faz compactado pelo winrar vo te manda o codigo do formulario de backup que eu tenho mais se não ajuda posta teu projeto.
    Tendo em vista que se voce usa back end e front end o back end nem precisa fazer backup pois ele demora muito pra cresce so com as tabelas, e quando cresce basta abrir e compactar, ja o front end e propicio a dar problema seja uma queda de energia, um reinicio forçado com o sistema aberto ele corrompe o front end mais nao danifica o back ai basta vc ter uma copia do front e substituir ela pronto.

    Option Compare Database
    Dim Escala          As Single
    Dim Evento          As Byte
    Dim objfs           As Object
    Dim DestinoNovo     As String
    Dim intCont         As Integer
    Dim strLocalWinRar  As String
    Private Sub Fechar_Click()
    DoCmd.Close acForm, "frmBackup", acSaveYes
    End Sub

    Private Sub btCaminho_Click()
    Dim strPasta As String
    strPasta = fncLocalizarPasta("Selecione a pasta para o Backup...")
    If strPasta = "" Then Exit Sub
    Me!txDestino = fncDestinoBackup(strPasta)
    End Sub

    Private Sub BTOK_Click()
    Me.Data_Backup = Date
    Me!Status.Caption = "Iniciando processo..."
    Screen.MousePointer = 11
    Me.TimerInterval = 2000
    Me.Usuário = getUsuarioAtual()
    Me.Hora_Backup = Time
    Me.Realizado = True
    End Sub

    Private Sub btSair_Click()
    DoCmd.Close
    End Sub



    Private Sub Form_BeforeUpdate(Cancel As Integer)
    If Me.NewRecord Then
       '------------------------
       'Auditar novo registro
       '------------------------
       Call fncAuditar(Me.Name, 0, "Backup " & Me!Cód_Backup & " Data " & Me.Data_Backup)
    Else
       '-------------------------
       'Auditar registro alterado
       '-------------------------
       Call fncAuditar(Me.Name, 1, "Backup " & Me!Cód_Backup & " Data " & Me.Data_Backup)
    End If
    End Sub

    Private Sub Form_Delete(Cancel As Integer)
    '---------------------------
    'Auditar registro excluido
    '---------------------------
    Call fncAuditar(Me.Name, 2, "Backup " & Me!Cód_Backup & " Data " & Me.Data_Backup)
    End Sub

    Private Sub Form_Load()
    Me.Caption = DLookup("[SistemaNome]", "[Configuração]") & "   v:  " & DLookup("[Versão]", "[Configuração]")
    End Sub

    Private Sub Form_Open(Cancel As Integer)
    DoCmd.GoToRecord , , acNewRec
    '----------------------------------------------------------------------------------
    'Verifica a presença do programa WinRAR
    'Grava o caminho na variável strLocalWinRar para ser usado na chamada do programa
    '-----------------------------------------------------------------------------------
    If Len(Dir(Environ("PROGRAMFILES(x86)") & "\Winrar\WinRAR.EXE") & "") > 0 Then
       strLocalWinRar = Environ("programFiles(x86)")
    ElseIf Len(Dir(Environ("PROGRAMFILES") & "\Winrar\WinRAR.EXE") & "") > 0 Then
       strLocalWinRar = Environ("programFiles")
    Else
       Me!selWinrar.enabled = False
    End If
    Me!txOrigem = fncOrigemBackup
    Me!txDestino = fncDestinoBackup
    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 11cm, em 8 pedaços
           '-------------------------------------------------------------------------
           Me!cx1.visible = True
           Me!btFoco.SetFocus
           Me!btCaminho.enabled = False
           Me!BTOK.enabled = False
           Escala = (11.2 * 567) / 8
           Me!cx1.Width = Escala
       Case 2
           Me!cx1.Width = Escala * 2
           Set objfs = CreateObject("Scripting.FileSystemObject")
           Me!Status.Caption = "Verificando Base de Dados..."
       Case 3
           Me!Status.Caption = "Copiando Base de Dados..."
           Me!cx1.Width = Escala * 3
       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
       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
           '-----------------------------------------------------------------------
           '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
           Me!cx1.Width = Escala * 5
           Set objws = Nothing
       Case 7
           '-------------------------------------------------
           'Executa o winrar oculto se este tiver habilitado
           '--------------------------------------------------
           If Me!selWinrar = True Then
               Me!Status.Caption = "Compactando com o Winrar..."
               Dim compri
               compri = Shell(strLocalWinRar & "\Winrar\WinRAR.EXE a " & Chr(34) & Replace(DestinoNovo, ".accdb", "") & ".rar" & Chr(34) & " " & Chr(34) & DestinoNovo & Chr(34), vbHide)
           End If
           Me!cx1.Width = Escala * 6
       Case 8
           If Me!selWinrar = True Then
               '--------------------------------------------------------------------------
               'Enquanto o winrar 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 winrar não
               'concluir a tarefa.
               '--------------------------------------------------------------------------
               If FileSystem.FileLen((Replace(DestinoNovo, ".accdb", "") & ".rar ")) = 0 Then
                   Evento = 7
                   If Me!cx1.Width < (11.2 * 567) Then intCont = intCont + 1
                   Me!cx1.Width = (Escala * 7) + (15 * intCont)
               Else
                   '----------------------------------------------------
                   'Deleto o arquivo que não foi compactado pelo WinRAR
                   '----------------------------------------------------
                   FileSystem.Kill DestinoNovo
                   Me!Status.Caption = "Backup concluído..."
                   Screen.MousePointer = 0
                   Me!cx1.Width = Escala * 8
                   Me.TimerInterval = 3000
               End If
           Else
               Me!Status.Caption = "Backup concluído..."
               Screen.MousePointer = 0
               Me!cx1.Width = Escala * 8
               Me.TimerInterval = 3000
           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 administrador 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

    Private Sub Form_Unload(Cancel As Integer)
    If Evento > 0 Then Cancel = True
    End Sub

    Private Function fncDestinoBackup(Optional Destino As String = "local") As String
    Dim strNomeBackEnd As String
    Dim strDestino As String
    On Error Resume Next
    strDestino = Replace(Destino, "local", CurrentProject.Path & "\backup")
    If Len(Dir(strDestino, vbDirectory) & "") = 0 Then FileSystem.MkDir (strDestino)
    strNomeBackEnd = fncNomeBackEnd
    strNomeBackEnd = Left(strNomeBackEnd, InStrRev(strNomeBackEnd, ".accdb") - 1)
    strNomeBackEnd = strNomeBackEnd & Format(Date, "ddmmyy") & "-" & Format(Time, "hhmmss") & ".accdb"
    fncDestinoBackup = strDestino & "\" & strNomeBackEnd
    End Function

    Private Function fncOrigemBackup() As String
    fncOrigemBackup = DLookup("path_0", "tblCaminhoBe")
    End Function
    Public Function fncNomeBackEnd() As String
    fncNomeBackEnd = DLookup("nomeBE", "tblCaminhoBE")
    End Function

    Public Function fncCapturaSenha() As Variant
    fncCapturaSenha = fncCrip(DLookup("senha", "tblCaminhoBE"), 102030)
    End Function

    Public Function fncProtegido() As Boolean
    Dim bd As DAO.Database
    On Error Resume Next
    '-------------------------------------------------
    'Tento abrir o banco sem passar a senha
    'Se o banco tiver a senha irá ocorrer o erro 3031
    '-------------------------------------------------
    Set bd = OpenDatabase(Me!txDestino, False, False)
    If err.Number = 3031 Then
       fncProtegido = True
    Else
       bd.Close
    End If
    Set bd = Nothing
    End Function

    LUCIEL-UDI gosta desta mensagem

    avatar
    LUCIEL-UDI
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 39
    Registrado : 19/12/2011

    [Resolvido]Como fazer backup de Tabelas com senha? Empty Re: [Resolvido]Como fazer backup de Tabelas com senha?

    Mensagem  LUCIEL-UDI 22/9/2022, 12:22

    Obrigado Marcelo3092 pela preciosa ajuda.

    Sempre aprendo muito com vocês.

    Descobri que o que estava causando o erro que apontei acima é que eu tinha salvado meu BD numa pasta no Google Drive e como minha Internet estava lenta ao pedir para salvar na pasta em questão, sobrepondo o arquivo que já constava lá, dava erro, porque o Drive não tinha feito o download da pasta para meu computador, assim quando o sistema ia fazer o backup não encontrava a pasta e dava erro.

    A solução era ou eu espera um tempo até o Drive baixar as pastas e arquivos da nuvem ou eu optava em deixar os arquivos em off-line, assim evitava o erro acima.

    Espero que tenham entendido o que aconteceu.

    No mais, muito obrigado mais uma vez pela atenção.

      Data/hora atual: 25/9/2022, 10:37