Ja to resavam tako sto u formu koja se prvo ucitava koja je splašskrin pozovem funkciju koja proveri stanje linkovanih tabela i ako ne može da ih pronađe pozivam funkciju za relinkovanje.
evo šta ja koristim pa ti prepravi kako tebi odgovara:
Code:
' Moraju se potvrditi reference za ADO i ADOX biblioteku
Function VerifyLinks(strDataDatabase As String, _
strSampleTable As String, Optional strOpciono As String) As Boolean
' Proverava stanje veze sa pridruženim tabelama.
' Ako otkrije prekinutu vezu prvo pretražuje tekući direktorijum.
' Ako u njemu ne nađe traženu bazu podataka, korisniku prikazuje
' okvir za dijalog za otvaranje datoteka.
' Polazna pretpostavka: sve veze vode ka istoj ciljnoj .MDB datoteci.
' Ulaz:
' strDataDatabase - Ime bek end baze podataka
' strSampleTable - Ime linkovane tabele za proveru
'
' strOpciono - Opcioni parametar u formatu: ImeTabele/PoljeTabele:
' ImeTabele - tabela u kojoj se čuva putanja direktorijuma baze
' za podatke i druge direktorijume koje koristi program;
' PoljeTabele - Ime polja u kome se čuva putanja
' razdvojeni su znakom "/"
' Izlaz:
' Povratna vrednost - True Ako je uspešno; False u ostalim slučajevima
'
' Ako je - True opciono je ubačeno da ako postoji parametar strOpciono
' ADO konekcijom upisuje novu putanju u polje poljeTabele
On Error GoTo VerifyLinksErr
Dim varReturn As Variant
Dim strDBDir As String ' direktorijum gde se nalazi baza sa podacima
Dim strMsg As String
Dim varFileName As Variant ' putanja baza za podatke
Dim intI As Integer
Dim intNumTables As Integer
Dim strProcName As String
Dim strFilter As String
Dim lngFlags As Long
Dim Cnn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim fd As FileDialog
Dim varSelektovanaStavka As Variant
Dim rsPutanja As ADODB.Recordset
Dim strSQL As String
Dim intPozicija As Integer ' pozicija karaktera razdvajanja "/" opcionog parametra strOpciono
Dim strImeTabele As String ' ime tabele u kojoj se čuva putanja za podatke
Dim strPoljeTabele As String ' ime polja tabele strImeTabele u kojoj je putanja podataka
strProcName = "VerifyLinks"
' Ispitujemo stanje veze sa tabelom čije je ime zadato u parametru strSampleTable.
varReturn = CheckLink(strSampleTable)
If varReturn Then
VerifyLinks = True
GoTo VerifyLinksDone
End If
' Učitavamo ime direktorijuma u kome se nalazi aplikaciona baza podataka.
strDBDir = CurrentProject.Path & "\"
' Ime baze podataka „za podatke“ zadato je u parametru strDatadatabase.
If (Dir$(strDBDir & strDataDatabase) <> "") Then
' Baza podataka je pronađena u tekućem direktorijumu.
' Dodati relinkovanje po potrebi!!!!!!!
varFileName = strDBDir & strDataDatabase
Else
' Potraži od korisnika da pronađe bazu za podatke koristeći FileDialog.
strMsg = "Potreban fajl '" & strDataDatabase & "' nije mogao biti pronađen." & vbCrLf & _
"Možete koristiti sledeći dijalog boks da locirate fajl na Vašem sistemu." & vbCrLf & vbCrLf & _
"Ako niste u mogućnosti da pronađete fajl ili niste sigurni šta trebate uraditi izaberite CANCEL" & vbCrLf & _
"na sledećem ekranu i pozovite administratora programa."
MsgBox strMsg, vbOKOnly + vbCritical, strProcName
' Prikaži FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialView = msoFileDialogViewList
.Title = "Lociranje fajla baze podataka"
.ButtonName = "Izaberi"
.AllowMultiSelect = False
.InitialFileName = strDataDatabase
If .Show = -1 Then
For Each varSelektovanaStavka In .SelectedItems
varFileName = varSelektovanaStavka
Next varSelektovanaStavka
Else ' Korisnik je pritisnuo CANCEL
strMsg = "Nemožete koristiti ovu bazu " & _
"dok je ne locirate! '" & strDataDatabase & "'."
MsgBox strMsg, vbOKOnly, vbCritical, strProcName
VerifyLinks = False
GoTo VerifyLinksDone
End If
End With
Set fd = Nothing
If Len(varFileName & "") = 0 Then
' Korisnik je pritisnuo Cancel.
strMsg = "Nemožete koristiti ovu bazu " & _
"dok je ne locirate! '" & strDataDatabase & "'."
MsgBox strMsg, vbOKOnly, vbCritical, strProcName
VerifyLinks = False
GoTo VerifyLinksDone
Else
varFileName = Trim(varFileName)
End If
End If
'Ponovno uspostavljanje veza. Najpre utvrđujemo ukupan broj tabela.
Set Cnn = CurrentProject.Connection
Set cat = New ADOX.Catalog
cat.ActiveConnection = Cnn
intNumTables = cat.Tables.Count
varReturn = SysCmd(acSysCmdInitMeter, _
"Uspostavljam veze sa tavelama", intNumTables)
' Petlja za proveravanje svih tabela. Ponovo se povezuju samo one
' čije svojstvo Connect nesadrži prazan znakovni niz.
intI = 0
For Each tbl In cat.Tables
If tbl.Type = "LINK" Then 'Ako je svojsto Type = "LINK", radi se o pridruženoj tabela.
intI = intI + 1
On Error Resume Next
' U sledećem redu veza se ponovo uspostavlja i osvežava.
' Ukoliko nova putanja nije u redu, nastaje greška kouju
' obrađujemo u sledećem redu.
tbl.Properties("Jet OLEDB:Link Datasource") = varFileName
'Ako je jedan link loš, return False.
If err.Number <> 0 Then
VerifyLinks = False
GoTo VerifyLinksDone
End If
End If
varReturn = SysCmd(acSysCmdUpdateMeter, intI + 1)
Next tbl
' Ovde ubacuujemo novu putanju baze za podatke ako postoji opcioni parametar strOpciono
If Not IsMissing(strOpciono) Then
intPozicija = InStr(strOpciono, "/")
strImeTabele = left(strOpciono, intPozicija - 1)
strPoljeTabele = right(strOpciono, (Len(strOpciono) - intPozicija))
strSQL = "SELECT " & strPoljeTabele & " FROM " & strImeTabele
Set rsPutanja = New ADODB.Recordset
rsPutanja.Open strSQL, Cnn, adOpenDynamic, adLockOptimistic
If Not rsPutanja.EOF Then
rsPutanja.Fields(strPoljeTabele) = varFileName
rsPutanja.Update
End If
rsPutanja.Close
Set rsPutanja = Nothing
End If
VerifyLinks = True
VerifyLinksDone:
On Error Resume Next
varReturn = SysCmd(acSysCmdRemoveMeter)
Set tbl = Nothing
Set cat = Nothing
Set Cnn = Nothing
Set fd = Nothing
Set rsPutanja = Nothing
Exit Function
VerifyLinksErr:
Select Case err.Number
Case Else
err.Raise err.Number, err.Source, err.Description, err.HelpFile, err.HelpContext
End Select
Resume VerifyLinksDone
End Function
Private Function CheckLink(strTable As String) As Boolean
' Proverava stanje veze sa zadatom tabelom.
' (Zapravo, CheckLink daje False i kada tabela nepostoji.)
' Ulaz:
' strTable - Tabela za proveru
' Izlaz:
' Izlazna vrednost - True ako je uspešna; False u ostalim slučajevima
On Error Resume Next
Dim Cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Set Cnn = CurrentProject.Connection
' Koristi metodu OpenSchema da popuni objekat tipa recordset sa podacima
' o kolonama tabele zadate u parametru strTable. Ako je skup podataka
' prazan to znači da Jet nije mogao da pronađe tabelu
' jer je veza verovatno prekinuta.
Set rst = Cnn.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, strTable, Empty))
CheckLink = Not rst.EOF
rst.Close
Set rst = Nothing
Set Cnn = Nothing
End Function
Prilagodi funkcije tvojim potrebama, pozdrav