Hallo allemaal,
Ik zit vast; hopelijk kan iemand me in de juiste richting wijzen. Ik werk met de onderstaande code om in runtime tabellen te linken vanuit mijn front end applicatie naar 3 databases. Dit werkt prima...., meestal. en van dat meestal wordt ik langzamerhand gek.
Als het linken niet lukt zijn de 'nieuwe' tabellen niet geschreven, maar de 'oude' zijn wel gewist; de gebruiker eindigt met een lege huls.
Public Function LinkAllTables(DbPath As String, iTable As Integer) As Boolean
'Alle tabellen linken in het pad; bestaand of niet
'Gelijke tabelnaam BE, FE
Dim rs As Recordset
Dim iCount As Integer
mWait
On Error Resume Next
'tabellen ophalen
Set rs = CurrentDb.OpenRecordset("SELECT Name " & _
"FROM MSysObjects IN '" & DbPath & "' " & _
"WHERE Type=1 AND Flags=0")
If Err <> 0 Then Exit Function
iCount = 0
Forms!frmBestandsLocNetwerk!pgr1.Max = iTable
Forms!frmBestandsLocNetwerk!pgr1 = iCount
'tabellen linken
Forms!frmBestandsLocNetwerk!txtTables = 0
DoEvents
While Not rs.EOF
iCount = iCount + 1
Forms!frmBestandsLocNetwerk!pgr1 = iCount
DoEvents
If DbPath <> Nz(DLookup("Database", "MSysObjects", "Name='" & rs!Name & "' And Type=6")) Then
'oude link weg als tabelnamen gelijk zijn
DoCmd.DeleteObject acTable, rs!Name
Sleep 500
'nieuwe link
DoCmd.TransferDatabase acLink, "Microsoft Access", DbPath, acTable, rs!Name, rs!Name
End If
Forms!frmBestandsLocNetwerk!txtTables = rs.RecordCount
DoEvents
Sleep 300
rs.MoveNext
Wend
rs.Close
LinkAllTables = True
Forms!frmBestandsLocNetwerk!pgr1 = iTable
mOK
Sleep 500
Forms!frmBestandsLocNetwerk!pgr1 = 0
End Function
Ik zit vast; hopelijk kan iemand me in de juiste richting wijzen. Ik werk met de onderstaande code om in runtime tabellen te linken vanuit mijn front end applicatie naar 3 databases. Dit werkt prima...., meestal. en van dat meestal wordt ik langzamerhand gek.

Als het linken niet lukt zijn de 'nieuwe' tabellen niet geschreven, maar de 'oude' zijn wel gewist; de gebruiker eindigt met een lege huls.
Public Function LinkAllTables(DbPath As String, iTable As Integer) As Boolean
'Alle tabellen linken in het pad; bestaand of niet
'Gelijke tabelnaam BE, FE
Dim rs As Recordset
Dim iCount As Integer
mWait
On Error Resume Next
'tabellen ophalen
Set rs = CurrentDb.OpenRecordset("SELECT Name " & _
"FROM MSysObjects IN '" & DbPath & "' " & _
"WHERE Type=1 AND Flags=0")
If Err <> 0 Then Exit Function
iCount = 0
Forms!frmBestandsLocNetwerk!pgr1.Max = iTable
Forms!frmBestandsLocNetwerk!pgr1 = iCount
'tabellen linken
Forms!frmBestandsLocNetwerk!txtTables = 0
DoEvents
While Not rs.EOF
iCount = iCount + 1
Forms!frmBestandsLocNetwerk!pgr1 = iCount
DoEvents
If DbPath <> Nz(DLookup("Database", "MSysObjects", "Name='" & rs!Name & "' And Type=6")) Then
'oude link weg als tabelnamen gelijk zijn
DoCmd.DeleteObject acTable, rs!Name
Sleep 500
'nieuwe link
DoCmd.TransferDatabase acLink, "Microsoft Access", DbPath, acTable, rs!Name, rs!Name
End If
Forms!frmBestandsLocNetwerk!txtTables = rs.RecordCount
DoEvents
Sleep 300
rs.MoveNext
Wend
rs.Close
LinkAllTables = True
Forms!frmBestandsLocNetwerk!pgr1 = iTable
mOK
Sleep 500
Forms!frmBestandsLocNetwerk!pgr1 = 0
End Function