Ændre link til sammenkædede tabeller

Hej joab,

Du er velkommen til at sende databasen til mig. Jeg har en løsning, hvor du ikke behøver at spekulere på hvor data.mdb ligger. Systemet kommer frem og spørger, hvis data ikke ligger hvor de er placeret. Derefter kan brugeren vælge den ny placering vha openfile-dialogboks.
Løsningen er dog for kompleks til at kunne beskrive her.

/Thomas

tj@makeiteasy.dk

Alternativt, kan du bruge denne funktion til at tilknytte til en bestemt database:

Public Function Sammenkæd(Sti As String)
    On Error Resume Next
    Dim db As Database, tdef As TableDef
    Dim constr As String, n As Integer
    Dim TblName As String
    Dim Connectstring As String, tblSourceName As String
    DoCmd.Hourglass True
    Set db = CurrentDb
    For n = 0 To db.TableDefs.Count - 1
        '<<----Hvis tabellen er tilknyttet---->>
        If tdef.Connect <> "" Then
            TblName = tdef.Name
            tblSourceName = tdef.SourceTableName
            DoCmd.DeleteObject acTable, TblName
            Set tdef = db.CreateTableDef(TblName)
            tdef.Connect = ";DATABASE=" & Sti
            tdef.SourceTableName = tblSourceName
            db.TableDefs.Append tdef
        End If
    Next n
    DoCmd.Hourglass False
    Beep
End Function

Du kan således kalde funktionen således:
Call Sammekæd(DFirst("DatabaseLink", "tblsys"))

/Thomas
www.makeiteasy.dk

Hej igen,

Jeg glemte lige at sige, at koden kræver en reference til DAO.

I VBA-vinduet, vælger du menuen Tools->References og herefter sikre du dig, at der er et kryds i "Microsoft DAO 3.x object Library".

/Thomas

Joab, har du fået kigget på det?

Hej Thomas
Tak for dine indlæg - jeg ser lige på det og vender tilbage.

Det viser sig, at jeg fik slettet en ret vigtig linie i eksemplet overfor. Koden skal herefter se således ud:

Public Function Sammenkæd(Sti As String)
    On Error Resume Next
    Dim db As Database, tdef As TableDef
    Dim constr As String, n As Integer
    Dim TblName As String
    Dim Connectstring As String, tblSourceName As String
    DoCmd.Hourglass True
    Set db = CurrentDb
    For n = 0 To db.TableDefs.Count - 1
        Set tdef = db.tabledefs(n)
        '<<----Hvis tabellen er tilknyttet---->>
        If tdef.Connect <> "" Then
            TblName = tdef.Name
            tblSourceName = tdef.SourceTableName
            DoCmd.DeleteObject acTable, TblName
            Set tdef = db.CreateTableDef(TblName)
            tdef.Connect = ";DATABASE=" & Sti
            tdef.SourceTableName = tblSourceName
            db.TableDefs.Append tdef
        End If
    Next n
    DoCmd.Hourglass False
    Beep
End Function

Jeg beklager fejlen!

/Thomas

Tak for rettelsen.
Det virker fint og du har helt sikkert fortjent dine point.

...men der er en dum lille fejl.

Hvis man får skiftet databasen til et forkert navn og man genstarte access forsvinder de sammenkædede tabeller.
Så skal de sammenkædes manuelt igen.

Det kunne være sjovt at se løsningen hvor systemet kommer frem og spørger.

Den er hermed fremsendt...

Hej
Jeg har en del problemer med den kode du har lagt her. Når jeg bruger den kan jeg ikke få FE til at køre på to maskiner samtidig. (FE er distribueret til hver lokal maskine)
Den linker godt nok alle tabellerne, men det går meget langsomt, og der kommer to gange fejlbesked til sidst. (ikke fra err.handler)
Jeg har godt nok ændret den en smule til:

Function AttachAll(strFileAndPath As String)
'Funktion til at linke alle tabeller til den ny-valgte DB BE-fil.
On Error GoTo err_handler

Dim db As DAO.Database
Dim tdef As DAO.TableDef
Dim TblName As String
Dim Connectstring As String, tblSourceName As String
Dim n As Integer

If Dir(strFileAndPath) <> "" Then
    Set db = CurrentDb
    For n = 0 To db.TableDefs.Count - 1  'For Each tdef In db.TableDefs
        Set tdef = db.TableDefs(n)
        If tdef.connect <> "" Then
            Err = 0

            TblName = tdef.name
            tblSourceName = tdef.SourceTableName
           
            DoCmd.DeleteObject acTable, TblName
            Set tdef = db.CreateTableDef(TblName)
            tdef.connect = "MS Access;PWD=" & backend_PW & ";DATABASE=" & strFileAndPath '";DATABASE=" & Sti
            tdef.SourceTableName = tblSourceName
            db.TableDefs.Append tdef
           
            If Err <> 0 Then
                RefreshLinks = False
                DoCmd.Hourglass False
                Exit Function
            End If
        End If
    Next n
End If

Exit Function

err_handler:
    MsgBox Err.description, vbCritical, "Fejl"
    Exit Function

End Function