VBA Access - Re-Conectando Tabelas - Relinking database tables


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



Tags: VBA, Access, tables, link, relinking, database, tabelas, re-conectando,




Nenhum comentário:

Postar um comentário

diHITT - Notícias