16. mesajda verdiğim linkteki uygulamada bulunan ReLink fonksiyonunu aşağıdaki kod ile değiştirirsen, bağlı tablo aynı dosya içinde iseler kendisi bulur
Kod:
Function ReLink(strDir As String, DefaultData As Boolean) _
As Boolean
Dim cat As ADOX.Catalog
Dim tdfRelink As ADOX.Table
Dim oDBInfo As DBInfo
Dim strPath As String
Dim strName As String
Dim intCounter As Integer
Dim vntStatus As Variant
vntStatus = SysCmd(acSysCmdSetStatus, "Yükleniyor")
Set cat = New ADOX.Catalog
Set oDBInfo = New DBInfo
With cat
.ActiveConnection = CurrentProject.Connection
oDBInfo.FullName = strDir
strPath = oDBInfo.FilePathOnly
strName = Left(oDBInfo.FileName, InStr(oDBInfo.FileName, ".") - 1)
On Error Resume Next
Call SysCmd(acSysCmdInitMeter, "Tablolar Bulundu ve Yükleme Başladı.", .Tables.Count)
For Each tdfRelink In .Tables
intCounter = intCounter + 1
Call SysCmd(acSysCmdUpdateMeter, intCounter)
If .Tables(tdfRelink.Name).Type = "LINK" Then
tdfRelink.Properties("Jet OLEDB:Link Datasource") = CurrentProject.path & "\" & "TABLOARINBULUNDUĞUMDBADI.mdb"
End If
If err.Number Then
Exit For
End If
Next tdfRelink
End With
Call SysCmd(acSysCmdRemoveMeter)
vntStatus = SysCmd(acSysCmdClearStatus)
ReLink = (err = 0)
End Function