hallo,
Eerste keer hier, dus ik hoop dat ik alles juist doe.
Ik wil een vba-scriptje maken dat de links tussen .mdb en .xls ververst:
alle tabellen in de database worden overlopen en de gelinkte tabellen (kan met andere db zijn maar ook met .xls file) moeten ververst worden.
Het filepath moet dynamisch zijn, de bronbestanden moeten in hetzelfde filepath staan (dit is de aanname)
dit is de code:
Private Sub RefreshLinks()
'this sub will refresh the links to the linked tables
'after running the code, the links will point to the tables in the file 'output_pure.mdb' in the same folder as this DB
Dim Dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Dim pureDBPath As String
Dim msgResult As Integer
Set Dbs = CurrentDb
Set Tdfs = Dbs.TableDefs
pureDBPath = Left(Dbs.Name, lastIndexOf(1, Dbs.Name, "\")) & "output_pure.mdb"
If Dir(pureDBPath) = "" Then
msgResult = MsgBox("Can not find " & pureDBPath & "! Table links will not be refreshed.", vbExclamation + vbOKOnly, "Warning!")
Exit Sub
End If
'Loop through the tables collection
For Each Tdf In Tdfs
If Tdf.SourceTableName <> "" Then 'If the table source is other than a base table
Tdf.Connect = ";DATABASE=" & pureDBPath 'Set the new source
On Error GoTo errorhandling
Tdf.RefreshLink 'Refresh the link
pureDBPath = Left(Dbs.Name, lastIndexOf(1, Dbs.Name, "\")) & "output_pure.mdb"
End If
Next 'Goto next table
errorhandling:
pureDBPath = Left(Dbs.Name, lastIndexOf(1, Dbs.Name, "\"))
Tdf.Connect = "Excel 5.0;HDR=YES;IMEX=2;DATABASE=" & pureDBPath & "Materials_database.xls"
Tdf.RefreshLink
Resume Next
End Sub
Private Function lastIndexOf(ByVal start As Integer, ByVal strBeingSearched As String, ByVal strToSearchFor As String) As Integer
lastIndexOf = InStr(start, strBeingSearched, strToSearchFor)
If lastIndexOf > 0 Then
While start > 0
lastIndexOf = start
start = InStr(start + 1, strBeingSearched, strToSearchFor)
Wend
End If
End Function
Het gaat mis bij
Tdf.Connect = "Excel 5.0;HDR=YES;IMEX=2;DATABASE=" & pureDBPath & "Materials_database.xls"
die tdf.connect naar excel loopt blijkbaar niet zoals het moet als er een link is naar een excel-file; ik krijg volgende foutboodschap:
runtime error 91: object variable or with block variable not set
Vreemd genoeg worden de links wel ververst (heb ik al getest) maar ik vermoed dat er toch iets niet helemaal koosjer loopt. (vb. waarvoor staat de 5.0, is dit versie?, ik heb het gekopieerd van een ander forum...);
Kan iemand me helpen met deze vervelende fout...
Alvast bedankt
Eerste keer hier, dus ik hoop dat ik alles juist doe.
Ik wil een vba-scriptje maken dat de links tussen .mdb en .xls ververst:
alle tabellen in de database worden overlopen en de gelinkte tabellen (kan met andere db zijn maar ook met .xls file) moeten ververst worden.
Het filepath moet dynamisch zijn, de bronbestanden moeten in hetzelfde filepath staan (dit is de aanname)
dit is de code:
Private Sub RefreshLinks()
'this sub will refresh the links to the linked tables
'after running the code, the links will point to the tables in the file 'output_pure.mdb' in the same folder as this DB
Dim Dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Dim pureDBPath As String
Dim msgResult As Integer
Set Dbs = CurrentDb
Set Tdfs = Dbs.TableDefs
pureDBPath = Left(Dbs.Name, lastIndexOf(1, Dbs.Name, "\")) & "output_pure.mdb"
If Dir(pureDBPath) = "" Then
msgResult = MsgBox("Can not find " & pureDBPath & "! Table links will not be refreshed.", vbExclamation + vbOKOnly, "Warning!")
Exit Sub
End If
'Loop through the tables collection
For Each Tdf In Tdfs
If Tdf.SourceTableName <> "" Then 'If the table source is other than a base table
Tdf.Connect = ";DATABASE=" & pureDBPath 'Set the new source
On Error GoTo errorhandling
Tdf.RefreshLink 'Refresh the link
pureDBPath = Left(Dbs.Name, lastIndexOf(1, Dbs.Name, "\")) & "output_pure.mdb"
End If
Next 'Goto next table
errorhandling:
pureDBPath = Left(Dbs.Name, lastIndexOf(1, Dbs.Name, "\"))
Tdf.Connect = "Excel 5.0;HDR=YES;IMEX=2;DATABASE=" & pureDBPath & "Materials_database.xls"
Tdf.RefreshLink
Resume Next
End Sub
Private Function lastIndexOf(ByVal start As Integer, ByVal strBeingSearched As String, ByVal strToSearchFor As String) As Integer
lastIndexOf = InStr(start, strBeingSearched, strToSearchFor)
If lastIndexOf > 0 Then
While start > 0
lastIndexOf = start
start = InStr(start + 1, strBeingSearched, strToSearchFor)
Wend
End If
End Function
Het gaat mis bij
Tdf.Connect = "Excel 5.0;HDR=YES;IMEX=2;DATABASE=" & pureDBPath & "Materials_database.xls"
die tdf.connect naar excel loopt blijkbaar niet zoals het moet als er een link is naar een excel-file; ik krijg volgende foutboodschap:
runtime error 91: object variable or with block variable not set
Vreemd genoeg worden de links wel ververst (heb ik al getest) maar ik vermoed dat er toch iets niet helemaal koosjer loopt. (vb. waarvoor staat de 5.0, is dit versie?, ik heb het gekopieerd van een ander forum...);
Kan iemand me helpen met deze vervelende fout...
Alvast bedankt
