MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Script de Beckup Winrar.

    Compartilhe

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 457
    Registrado : 20/01/2014

    [Resolvido]Script de Beckup Winrar.

    Mensagem  XPTOS em Ter 20 Maio 2014, 21:42

    Prezados!

    Dim strlocal
    Dim objws

    Apreciei este código no projeto Maestro do Avelino e tenho a seguinte dúvida. É possível rodar esse script pelo agendador de tarefas do windows de modo que ele possa compactar o meu BE pelo Winrar?



    on error resume next

    Set objws = CreateObject("wscript.shell")

    strlocal = "C:\Users\wagomes\Desktop\Base dados SAC\SAC - Sistema de Análise de Contas 2007.accdb" ' caminho do meu banco

    'ch(34) = Aspas

    strlocal = Chr(34) & "MSACCESS.EXE" & Chr(34) & " " & Chr(34) & strlocal & Chr(34)

    '0 - oculto
    '5 - visivel

    ObjWS.Run strlocal, 0,"false"

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 457
    Registrado : 20/01/2014

    Re: [Resolvido]Script de Beckup Winrar.

    Mensagem  XPTOS em Sab 24 Maio 2014, 02:59

    UP.

    Avelino Sampaio
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3348
    Registrado : 04/04/2010

    Re: [Resolvido]Script de Beckup Winrar.

    Mensagem  Avelino Sampaio em Sab 24 Maio 2014, 09:05

    Olá!

    Abra o aplicativo backup_at.accdb oferecido neste meu artigo:

    [Você precisa estar registrado e conectado para ver este link.]

    E altere o código para:

    Option Compare Database
    Option Explicit

    Public Function fncbackup()
    Dim booResultado As Boolean
    Dim objws As Object
    Dim objfs As Object
    Dim strOrigem As String
    Dim strDestino As String
    Dim strDestinoNovo As String
    Dim strLocalWinRar As String
    Dim compri

    On Error GoTo trataerro

    '--------------------------------------------------------------------
    'AQUI VOCÊ TROCA PARA O CAMINHO E PARA O NOME DO SEU BACK-END
    '---------------------------------------------------------------------
    strOrigem = "c:\Maestro\Maestro_v5_be.accdb"
    strDestino = "c:\Maestro\backup\Maestro_v5_be" & Format(Date, "ddmmyy") & "-" & Format(Time, "hhmmss") & ".accdb"

    Set objfs = CreateObject("Scripting.FileSystemObject")
    '-----------------------------
    'Realiza uma copia o Back-end
    '-----------------------------
    objfs.CopyFile strOrigem, strDestino
    '---------------------------------------------------------------
    'Entra com a senha de acesso do back-end ao compactar e reparar
    '--------------------------------------------------------------
    Set objws = CreateObject("wscript.shell")
    objws.SendKeys "a1234", True
    objws.SendKeys "{ENTER}"
    strDestinoNovo = Replace(strDestino, "-", "-c")
    booResultado = Application.CompactRepair(strDestino, strDestinoNovo, True)
    '------------------------------------------
    'Deleta a copia do back-end não compactada
    '------------------------------------------
    If booResultado = True Then FileSystem.Kill strDestino

    '------------------------------------
    'Empacota o back-end com o Winrar
    '------------------------------------
    If Len(Dir(Environ("PROGRAMFILES(x86)") & "\Winrar\WinRAR.EXE") & "") > 0 Then
       strLocalWinRar = Environ("programFiles(x86)")
    Else
       strLocalWinRar = Environ("programFiles")
    End If
    compri = Shell(strLocalWinRar & "\Winrar\WinRAR.EXE a " & Replace(strDestinoNovo, ".accdb", "") & ".rar " & strDestinoNovo, vbHide)

    '----------------------------------------------------------------
    'Deleta a copia do back-end, sobrando apenas a copia do Winrar
    '----------------------------------------------------------------
    If booResultado = True Then FileSystem.Kill strDestinoNovo

    Set objws = Nothing
    Set objfs = Nothing
           
    If Len(Dir(Left(strDestino, InStrRev(strDestino, "\")) & "*.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

    sair:
       DoCmd.Quit acQuitSaveAll
       Exit Function
    trataerro:
       MsgBox Err.Number & " - " & Err.Description, vbInformation, "Aviso"
       Resume sair
    End Function


    Nota:  altere a linha abaixo no seu arquivo script, chamando pelo aplicativo backup_at.accdb

    strlocal = "C:\SuaPasta\Backup_at.accdb"

    Sucesso!


    .................................................................................
    ============ Quer aprender Access em alta velocidade ? ============

    || [Você precisa estar registrado e conectado para ver esta imagem.] Acesse o site UsandoAccess.com.br e veja um ótimo kit de ensino que tenho para você.

    ===========================================================

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 457
    Registrado : 20/01/2014

    Re: [Resolvido]Script de Beckup Winrar.

    Mensagem  XPTOS em Dom 25 Maio 2014, 00:20

    Perfeito Avelino Sampaio...

    Grato,

    XPTOS
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 457
    Registrado : 20/01/2014

    Script de Beckup Winrar.

    Mensagem  XPTOS em Seg 26 Maio 2014, 13:24

    Reabrindo tópico.

    Adaptei o código ao meu projeto, falta apenas um pequeno ajuste para ele compactar o BE.

    Se tiver uma sugestação, agradeço antecipadamente.

    Option Compare Database
    Option Explicit

    Public Function fncbackup()
    Dim booResultado As Boolean
    Dim objws As Object
    Dim objfs As Object
    Dim strOrigem As String
    Dim strDestino As String
    Dim strDestinoNovo As String
    Dim strLocalWinRar As String
    Dim compri

    On Error GoTo trataerro

    '--------------------------------------------------------------------
    'AQUI VOCÊ TROCA PARA O CAMINHO E PARA O NOME DO SEU BACK-END
    '---------------------------------------------------------------------
    strOrigem = "C:\Users\wagomes\Desktop\Base dados SAC\SAC - Sistema de Análise de Contas 2007_be.accdb"
    strDestino = "C:\Users\wagomes\Desktop\Base dados SAC\Backup_SAC\SAC - Sistema de Análise de Contas 2007_be" & Format(Date, "ddmmyy") & "-" & Format(Time, "hhmmss") & ".accdb"

    Set objfs = CreateObject("Scripting.FileSystemObject")
    '-----------------------------
    'Realiza uma copia o Back-end
    '-----------------------------
    objfs.CopyFile strOrigem, strDestino
    '---------------------------------------------------------------
    'Entra com a senha de acesso do back-end ao compactar e reparar
    '--------------------------------------------------------------
    Set objws = CreateObject("wscript.shell")
    objws.SendKeys "", True
    objws.SendKeys "{ENTER}"

    strDestinoNovo = Replace(strDestino, "-", "-c")
    booResultado = Application.CompactRepair(strDestino, strDestinoNovo, True)
    '------------------------------------------
    'Deleta a copia do back-end não compactada
    '------------------------------------------
    If booResultado = True Then FileSystem.Kill strDestino

    '------------------------------------
    'Empacota o back-end com o Winrar
    '------------------------------------
    If Len(Dir(Environ("PROGRAMFILES(x86)") & "\Winrar\WinRAR.EXE") & "") > 0 Then
    strLocalWinRar = Environ("programFiles(x86)")
    Else
    strLocalWinRar = Environ("programFiles")
    End If

    compri = Shell(strLocalWinRar & "\Winrar\WinRAR.EXE a " & Chr(34) & Replace(strDestinoNovo, ".accdb", "") & ".rar" & Chr(34) & "" & Chr(34) & strDestinoNovo & Chr(34), vbHide)

    '----------------------------------------------------------------
    'Deleta a copia do back-end, sobrando apenas a copia do Winrar
    '----------------------------------------------------------------
    If booResultado = True Then FileSystem.Kill strDestinoNovo

    Set objws = Nothing
    Set objfs = Nothing

    If Len(Dir(left(strDestino, InStrRev(strDestino, "\")) & "*.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

    sair:
    DoCmd.Quit acQuitSaveAll
    Exit Function
    trataerro:
    MsgBox err.Number & " - " & err.Description, vbInformation, "Aviso"
    Resume sair
    End Function



      Data/hora atual: Dom 04 Dez 2016, 20:18