[Resolvido]Caminho de tabelas ligadas

Boas

Gostaria de saber se há alguma forma de retirar o caminho das tabelas ligadas do gestor de tabelas ligadas, para inserir num código de backup.

Olá Luis,
Retirar ou capturar o caminho?
Abraço

Teixeira
A Ideia é o beckup capturar a path da no gestor de tabelas. Isto evitaria de mudar manualmente o caminho da tabela ligada no código

Correcção
Isto evitaria de mudar manualmente o caminho da tabela ligada no código quero dizer:
Isto evitaria de mudar manualmente o caminho da Base de dados

Código:

Dim dbs As Database
Dim tdf As TableDef

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


Olá a todos,
Luís Antunes, deve descrever melhor o que pretende.
Está aí a resposta do nosso colega Cláudio Más (a qual agradeço) para obter o caminho da tabela que está ligada.
Se tiver mais que uma base de dados ligada, retire o Exit For e veja (teste) o resultado.
Abraço a todos

Este código, elaborado por J Paulo, quero aplicá-lo ao meu projecto. Acontece que o meu back end está nutro directório.
Queria substituir o CurrentProject.Path para TableDef

Código:



Private Sub Form_Close()
'Mensagem 9
'elaborado por: JPaulo - 11/10/2006
'objectivo: criar (1) uma copia de segurança por mês
' pode ser alterado para (1) uma por dia, ou uma (1) por ano, para
'isso basta alterarem o Format(Now(), "_mmyyyy") para Format(Now(), "_ddmmyyyy")
'O caminho tem de ter o nome da pasta, neste caso Backup e o nome que querem dar
' à MDB da cópia.
'Revisão em 30-09-2010, para manter os 3 ultimos backups do dia.
On Error Resume Next

Dim fso As Object
Dim tdf As TableDef
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists("C:\Backup") Then ' verifica se já existe a pasta
Else
MkDir "c:\Backup" 'se não existir cria
End If

Dim CopiaSegura As Object
Dim Caminho As String
Dim CopiaBancoTabelas As Object
Dim CaminhoTabelas As String
Dim x, y, z As String

Caminho = "C:\Backup\Tires_be" 'Nome da pasta e nome de inicio para o banco de backup
Set CopiaSegura = CreateObject("Scripting.FileSystemObject")

x = Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 1 & ".accdb"
y = Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 2 & ".accdb"
z = Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 3 & ".accdb"


If Not (Len(Dir(x, vbDirectory)) > 0) Then
CopiaSegura.CopyFile CurrentProject.Path & "\Tires_be.accdb", Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 1 & ".accdb"
ElseIf Not (Len(Dir(y, vbDirectory)) > 0) Then
CopiaSegura.CopyFile CurrentProject.Path & "\Tires_be.accdb", Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 2 & ".accdb"
Else
Kill z
CopiaSegura.CopyFile CurrentProject.Path & "\Tires_be.accdb", Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 3 & ".accdb"
End If
Quit acQuitSaveAll
End Sub

Olá Luis Antunes,
Assim fica muito mais facil compreender  

Adatei o código do colega Cláudio Más para uma função.
No seu porjecto crie um módulo novo (mod_backup) e cole o código abaixo:

Código:

Function fncPathPrimeiraTabelaLigada()
' Origem..: (Cláudio Más) http://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


No seu código, altere por este:

Código:

'Mensagem 9
'elaborado por: JPaulo - 11/10/2006
'objectivo: criar (1) uma copia de segurança por mês
' pode ser alterado para (1) uma por dia, ou uma (1) por ano, para
'isso basta alterarem o Format(Now(), "_mmyyyy") para Format(Now(), "_ddmmyyyy")
'O caminho tem de ter o nome da pasta, neste caso Backup e o nome que querem dar
' à MDB da cópia.
'Revisão em 30-09-2010, para manter os 3 ultimos backups do dia.

' Origem..: http://www.maximoaccess.com/t27625-caminho-de-tabelas-ligadas
' Alterado: Alvaro Teixeira (ahteixeira)
' Data ...: 11-08-2016
' Alteração de   CurrentProject.Path & "\nomeDaBaseDeDados_be.accdb"
' para variavél que pesquisa através da função fncPathPrimeiraTabelaLigada
' a primeira tabela ligada.
On Error Resume Next

    Dim fso As Object
    Dim tdf As TableDef
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If fso.FolderExists("C:\Backup") Then ' verifica se já existe a pasta
    Else
        MkDir "c:\Backup" 'se não existir cria
    End If
    
    Dim CopiaSegura As Object
    Dim Caminho As String
    Dim CopiaBancoTabelas As Object
    Dim CaminhoTabelas As String
    Dim x, y, z, sPathBackup As String
    
    sPathBackup = fncPathPrimeiraTabelaLigada
    
    Caminho = "C:\Backup\Tires_be" 'Nome da pasta e nome de inicio para o banco de backup
    Set CopiaSegura = CreateObject("Scripting.FileSystemObject")
    
    x = Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 1 & ".accdb"
    y = Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 2 & ".accdb"
    z = Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 3 & ".accdb"
    
    
    If Not (Len(Dir(x, vbDirectory)) > 0) Then
        CopiaSegura.CopyFile sPathBackup, Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 1 & ".accdb"
    ElseIf Not (Len(Dir(y, vbDirectory)) > 0) Then
        CopiaSegura.CopyFile sPathBackup, Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 2 & ".accdb"
    Else
        If (Len(Dir(z, vbDirectory)) > 0) Then Kill z
        CopiaSegura.CopyFile sPathBackup, Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 3 & ".accdb"
    End If
    Quit acQuitSaveAll
End Sub

Abraço

Olá, verifiquei o código que postou e tem um erro se tiver no tratamento de erros Parar em Todos.

Onde tem:

Código:

Else
    Kill z
    CopiaSegura.CopyFile sPathBackup, Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 3 & ".accdb"
End If

altere por:

Código:

Else
    If (Len(Dir(z, vbDirectory)) > 0) Then Kill z
    CopiaSegura.CopyFile sPathBackup, Caminho & Format(Now, "_dd-mm-yyyy") & "_" & 3 & ".accdb"
End If

Só ocorria ao fazer a copia 3.
Corrigido também na mensagem anterior.

Os utilizadores que tiverem o sistema configurado conforme imagem abaixo o erro não ocorre.:


Abraço

Teixeira

No meu 2007, e não alterei está diferente.

Esta no circulo vermelho.

Correu tudo lindamente. Um agradecimento a A. Teixera e C. Más, por tudo.
PS: um senão
Se todos os dias fizer um backup o 3º backup é o único actualizado, isto é, ao fim de alguns dias os backups 1 e 2 já perderam a validade.
Se não houver forma automática de renovação, dos backups 1 e 2, terei que o fazer manualmente.

Olá Luís Antunes, obrigado pelo retorno.
O propósito do código, segundo o autor é fazer 3 cópias diárias.

Se pretende fazer mais, pode adicionar ao nome do ficheiro do backup a hora e fica com os que pretender.
Alterei o código para exemplo do referido:

Código:

On Error Resume Next

    Dim fso As Object
    Dim tdf As TableDef
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    If fso.FolderExists("C:\Backup") Then ' verifica se já existe a pasta
    Else
        MkDir "c:\Backup" 'se não existir cria
    End If
   
    Dim CopiaSegura As Object
    Dim Caminho As String
    Dim CopiaBancoTabelas As Object
    Dim CaminhoTabelas As String
    Dim sPathBackup As String
   
    sPathBackup = fncPathPrimeiraTabelaLigada
    Caminho = "C:\Backup\Tires_be" 'Nome da pasta e nome de inicio para o banco de backup
 
    Set CopiaSegura = CreateObject("Scripting.FileSystemObject")
       
    CopiaSegura.CopyFile sPathBackup, Caminho & Format(Now, "_dd-mm-yyyy_HH_MM_SS") & ".accdb"
   
    Quit acQuitSaveAll
End Sub


Abraço

Olá Assis,

Você pode não ter alterado, no entanto pode ter experimentado um exemplo qualquer que altere essa propriedade.
Eu normalmente uso parar em todos os erros (principalmente em desenvolvimento).
Muitos dos colegas se colocarem neste modo e testar a v/aplicação vão ter supresa!  

No entanto a maioria usa parar em modo de classe, que será o mais adequado para instalação em clientes (produção).

Espero ter esclarecido a sua questão.
Abraço

A Teixeira
Não há problema em haver 3 cópias, mais que isso é desnecessário, o que digo na mensagem anterior é que depois de fazer 3 cópias as seguintes vão sempre substituir a 3ª, as 1ªs e a 2ªs cópias vão ficando desactualizadas com o tempo. Isto é o mesmo que substituir sempre a 1ª, deixando de haver 2ªs e 3ªs cópias.

Mais uma vez um obrigado

Um abraço

Luís Antunes

Olá, sim, mas no dia seguinte volta a fazer mais três.
Abraço