✔ Programação GLOBAL®: VBA Access - Re-Conectando Tabelas

VBA Access - Re-Conectando Tabelas - Relinking database tables

DESENVOLVO APLICAÇÕES VBA

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba 3 Calendários Customizáveis de 2013 em Excel

Usando Gauges em Dashboards no MS Access

Você tem direito as informações da sua empresa

Que tal você ter disponível um código que re-vincule todas as tabelas em um banco de dados. Este código foi configurado para ser executado automaticamente a partir de uma macro AutoExec que chama a função.

Function RefreshTableLinks() As String

On Error GoTo ErrHandler

Dim strEnvironment As String

Let strEnvironment = GetEnvironment

Dim db As DAO.Database

Dim tdf As DAO.TableDef

Dim strCon As String

Dim strBackEnd As String

Dim strMsg As String

Dim intErrorCount As Integer

Set db = CurrentDb

'Loop through the TableDefs Collection.

For Each tdf In db.TableDefs

'Verify the table is a linked table.

If Left$(tdf.Connect, 10) = ";DATABASE=" Then

'Get the existing Connection String.

  Let strCon = Nz (tdf.Connect, "")

'Get the name of the back-end database using String Functions.

  Let strBackEnd = Right$(strCon, (Len(strCon) - (InStrRev(strCon, "\") - 1)))



If Len(strBackEnd & "") > 0 Then

Set tdf = db.TableDefs(tdf.Name)

If strBackEnd = "\Common Shares_Data.mdb" Or strBackEnd = "\Adverse Events.mdb" Then



tdf.Connect = ";DATABASE=" & strEnvironment & strBackEnd

Else

tdf.Connect = ";DATABASE=" & CurrentProject.Path & strBackEnd

End If

tdf.RefreshLink

End If

End If

Next tdf

ErrHandler:

If Err.Number <> 0 Then

MsgBox ("Error Number: " & Err.Number & vbCrLf & _

"Error Description: " & Err.Description & vbCrLf)

End If

End Function