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]Backup de base de dados ligada/vinculada (BackEnd)

    avatar
    Luís Antunes
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 332
    Registrado : 05/04/2016

    [Resolvido]Backup de base de dados ligada/vinculada (BackEnd) Empty [Resolvido]Backup de base de dados ligada/vinculada (BackEnd)

    Mensagem  Luís Antunes em 3/8/2020, 00:10

    Boas noites
    Este primeiro código localiza a BD_be

    Código:
    Function fncPathPrimeiraTabelaLigada()
    ' Origem..: (Cláudio Más) https://www.maximoaccess.com/t27625-caminho-de-tabelas-ligadas
    ' Alterado: Alvaro Teixeira (ahteixeira)
    ' Data ...: 13-08-2016

        Dim dbs As DAO.Database
        Dim tdf As TableDef
        
      

     Set dbs = CurrentDb
        For Each tdf In dbs.TableDefs
            If Len(tdf.Connect) > 0 Then
                fncPathPrimeiraTabelaLigada = right$(tdf.Connect, Len(tdf.Connect) - 10)
                Exit For
            End If
        Next tdf
    End Function

    Este segundo, de JPaulo, zipa a BD

    Código:
    Public Sub ZipaBanco()
    'JPaulo :registered: Maximo Access
        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 'Caminho da pasta onde está o banco a zipar
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If
      
        strDate = Format(Now, "dd-mmmm-yyyy_hh-mm")
        FileNameZip = DefPath & "Backup_" & strDate & ".zip"

        strPrefix = "SeuBanco" '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"
        
            On Error Resume Next
        CriaNovoZip (FileNameZip)
        Set oApp = CreateObject("Shell.Application")
        oApp.NameSpace(FileNameZip).CopyHere FName
        MsgBox "Criado com Sucesso em: " & FileNameZip
        Set oApp = Nothing
       Exit Sub
    End Sub


    Public Sub CriaNovoZip(sPath)
    'Criado pelo meu amigo e colega Raw do Canadá
    'Adaptado por JPaulo :registered: 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


    Gostaria que este segundo código localizasse a BD_be através do primeiro código.
    Em resumo o que pretendo é que o código localize o be através da TableDefs
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]Backup de base de dados ligada/vinculada (BackEnd) Empty Re: [Resolvido]Backup de base de dados ligada/vinculada (BackEnd)

    Mensagem  ahteixeira em 3/8/2020, 00:35

    Olá Luís Antunes,

    Se compreendi bem a dúvida, onde tem:
    Código:
    FName = Application.CurrentProject.Path & "\" & strPrefix & ".accdb"
    altere por:
    Código:
    FName = fncPathPrimeiraTabelaLigada

    Ficando desta forma a função do JPaulo:
    Código:
    Public Sub ZipaBanco()
    'JPaulo ® Maximo Access
        Dim strDate As String, DefPath As String
        Dim oApp As Object
        Dim FName, FileNameZip
        On Error Resume Next

        DefPath = Application.CurrentProject.Path 'Caminho da pasta onde está o banco a zipar
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If
     
        strDate = Format(Now, "dd-mmmm-yyyy_hh-mm")
        FileNameZip = DefPath & "Backup_" & strDate & ".zip"
     
        FName = fncPathPrimeiraTabelaLigada  'ahteixeira 2020

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

    Abraço
    avatar
    Luís Antunes
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 332
    Registrado : 05/04/2016

    [Resolvido]Backup de base de dados ligada/vinculada (BackEnd) Empty Re: [Resolvido]Backup de base de dados ligada/vinculada (BackEnd)

    Mensagem  Luís Antunes em 3/8/2020, 16:02

    Boa tarde ahteixeira

    Ficou óptimo, fico-lhe agradecido.
    Fiz uma pequena alteração, agora o zip fica no directório à minha escolha, quando o directório não existe o código cria-o.


    Código:
    Public Sub ZipaBanco()
    'JPaulo ® Maximo Access
        Dim strDate As String, DefPath As String
        Dim oApp As Object
        Dim FName, FileNameZip
        
         Dim FSO As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")
        
         On Error Resume Next

        DefPath = Application.CurrentProject.Path 'Caminho da pasta onde está o banco a zipar
        If right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If
        
        If FSO.FolderExists("C:\Backup") Then ' verifica se já existe a pasta
        Else
            MkDir "c:\Backup" 'se não existir cria
        End If
      
        strDate = Format(Now, "dd-mmmm-yyyy_hh-mm")
        FileNameZip = "C:\Backup\" & "Backup_" & strDate & ".zip"
      
        FName = fncPathPrimeiraTabelaLigada  'ahteixeira 2020

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

    bacano gosta desta mensagem

    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]Backup de base de dados ligada/vinculada (BackEnd) Empty Re: [Resolvido]Backup de base de dados ligada/vinculada (BackEnd)

    Mensagem  ahteixeira em 3/8/2020, 22:13

    Olá Luís Antunes,

    Fico feliz por ter ajudado, obrigado pela partilha.
    Não se esqueça de dar o tópico como Resolvido, veja como fazer:
    https://www.maximoaccess.com/t860-resolucao-de-topicos

    Abraço

    avatar
    Luís Antunes
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 332
    Registrado : 05/04/2016

    [Resolvido]Backup de base de dados ligada/vinculada (BackEnd) Empty Re: [Resolvido]Backup de base de dados ligada/vinculada (BackEnd)

    Mensagem  Luís Antunes em 3/8/2020, 23:18

    Tenho quase a certeza que dei o assunto como resolvido, no entanto fica a dúvida.
    As minhas desculpas.

    Luís Antunes
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]Backup de base de dados ligada/vinculada (BackEnd) Empty Re: [Resolvido]Backup de base de dados ligada/vinculada (BackEnd)

    Mensagem  ahteixeira em 4/8/2020, 13:31

    cheers

      Data/hora atual: 4/12/2020, 11:16