Hello
I have a big database and I have this follow problems.
Some subform stop to works when I re link the link Table with
VB code this is the code:
One of then I delete and create the link tables (SQL Server) I do that because I need diferent ODBC (DNS)
************************************************** *******************
' Create table with ODBC "DB1"
Public Function Create_NewLinkedtable()
Dim SQLCONNECTSTRING As String, MyDB As Database, rs As Recordset
Dim td As TableDef, str As String
Dim collTbls As Collection
Set collTbls = fGetLinkedTables
For i = collTbls.Count To 1 Step -1
Set MyDB = CurrentDb
strTbl = fParseTable(collTbls(i))
str = strTbl
MyDB.TableDefs.Delete (str)
SQLCONNECTSTRING = "ODBC;DSN=DB1;APP=Microsoft Office 2003;WSID=Lijandra;DATABASE=DataLink;Network=DBMSS OCN;Trusted_Connection=Yes;"
Debug.Print "Add " & str
Set td = MyDB.CreateTableDef(str)
td.Connect = SQLCONNECTSTRING
td.SourceTableName = str
MyDB.TableDefs.Append td
Next
End Function
Public Function fGetLinkedTables() As Collection
'Returns all linked tables
Dim collTables As New Collection
Dim tdf As TableDef, db As Database
Set db = CurrentDb
db.TableDefs.Refresh
For Each tdf In db.TableDefs
With tdf
If Len(.Connect) > 0 Then
If Left$(.Connect, 4) = "ODBC" Then
collTables.Add Item:=.Name & ";" & .Connect, Key:=.Name
End If
'ODBC Reconnect handled separately
Else
collTables.Add Item:=.Name & .Connect, Key:=.Name
End If
End If
End With
Next
Set fGetLinkedTables = collTables
Set collTables = Nothing
Set tdf = Nothing
Set db = Nothing
End Function
Function fParseTable(strIn As String) As String
fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
End Function
'************************************************* ********************
The Other Form I Relink the link tables like this code.
Public Function fRefreshLinks() As Boolean
Dim strMsg As String, collTbls As Collection
Dim i As Integer, strDBPath As String, strTbl As String
Dim dbCurr As Database, dbLink As Database
Dim tdfLocal As TableDef
Dim varRet As Variant
Dim strNewPath As String
Dim LabelCopies&
Dim strWSID As String
Const cERR_USERCANCEL = vbObjectError + 1000
Const cERR_NOREMOTETABLE = vbObjectError + 2000
On Local Error GoTo fRefreshLinks_Err
If MsgBox("Are you sure you want to reconnect all Access tables?", _
vbQuestion + vbYesNo, "Please confirm...") = vbNo Then err.Raise cERR_USERCANCEL
strWSID = InputBox$("Enter ODBC Name")
'First get all linked tables in a collection
Set collTbls = fGetLinkedTables
'now link all of them
Set dbCurr = CurrentDb
strMsg = "Do you wish to specify a different path for the Access Tables?"
For i = collTbls.Count To 1 Step -1
strDBPath = fParsePath(collTbls(i))
strTbl = fParseTable(collTbls(i))
varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl & "'....")
Dim pepe As String
pepe = Left$(strDBPath, 4)
If Left$(strDBPath, 4) <> "ODBC" Then
'ODBC Tables
Else
If strNewPath <> vbNullString Then
'Try this first
strDBPath = strNewPath
Else
If Len(Dir(strDBPath)) = 0 Then
'File Doesn't Exist, call GetOpenFileName
strDBPath = fGetMDBName("'" & strDBPath & "' not found.", strWSID)
If strDBPath = vbNullString Then
'user pressed cancel
err.Raise cERR_USERCANCEL
End If
End If
End If
'backend database exists
'putting it here since we could have
'tables from multiple sources
Set dbLink = DBEngine.OpenDatabase("", False, False, strDBPath)
'check to see if the table is present in dbLink
strTbl = fParseTable(collTbls(i))
If fIsRemoteTable(dbLink, strTbl) Then
'everything's ok, reconnecthun
Set tdfLocal = dbCurr.TableDefs(strTbl)
With tdfLocal
.Connect = strDBPath
.RefreshLink
collTbls.Remove (.Name)
End With
Else
err.Raise cERR_NOREMOTETABLE
End If
End If
Next
fRefreshLinks = True
varRet = SysCmd(acSysCmdClearStatus)
MsgBox "All Access tables were successfully reconnected.", _
vbInformation + vbOKOnly, _
"Success"
fRefreshLinks_End:
Set collTbls = Nothing
Set tdfLocal = Nothing
Set dbLink = Nothing
Set dbCurr = Nothing
Exit Function
fRefreshLinks_Err:
fRefreshLinks = False
Select Case err
Case 3059:
Case cERR_USERCANCEL:
MsgBox "No Database was specified, couldn't link tables.", _
vbCritical + vbOKOnly, _
"Error in refreshing links."
Resume fRefreshLinks_End
Case cERR_NOREMOTETABLE:
MsgBox "Table '" & strTbl & "' was not found in the database" & _
vbCrLf & dbLink.Name & ". Couldn't refresh links", _
vbCritical + vbOKOnly, _
"Error in refreshing links."
Resume fRefreshLinks_End
Case Else:
strMsg = "Error Information..." & vbCrLf & vbCrLf
strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
strMsg = strMsg & "Description: " & err.Description & vbCrLf
strMsg = strMsg & "Error #: " & Format$(err.Number) & vbCrLf
MsgBox strMsg, vbOKOnly + vbCritical, "Error"
Resume fRefreshLinks_End
End Select
End Function
Function fParsePath(strIn As String) As String
Dim str As Integer
Dim str1 As Integer
Dim str2 As String
str = InStr(1, strIn, "ODBC;")
str1 = Len(strIn)
str2 = Len(strIn) - (InStr(1, strIn, "ODBC;") + 8)
If Left$(strIn, 4) <> "ODBC" Then
fParsePath = Right(strIn, Len(strIn) _
- (InStr(1, strIn, "ODBC;") - 1))
Else
fParsePath = strIn
End If
End Function
Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
Dim tdf As TableDef
On Error Resume Next
Set tdf = dbRemote.TableDefs(strTbl)
fIsRemoteTable = (err = 0)
Set tdf = Nothing
End Function
Function fGetMDBName(strIn As String, strWSID As String) As String
Dim strFilter As String
Dim SQLCONNECTSTRING As String
SQLCONNECTSTRING = "ODBC;DSN=" & strWSID & ";APP=Microsoft Office 2003;WSID=lijandra;DATABASE=DataLink;Network=DBMSS OCN;Trusted_Connection=Yes"
fGetMDBName = SQLCONNECTSTRING
End Function
Both code broke my database.
I do the follow steps
Relink all tables With âLinked Table Managerâ to âDB1â. Donât Works.
Relink all tables With â
VB Codeâ to âDB1â. Donât Works.
Import in a new Database The conflictive forms and queries, macros, tables, reports associates to this forms, from DataLinkv06.mdb. Donât works
Import in a new Database The conflictive forms and queries, macros, tables, reports associates to this forms, from DataLinkv06.mdb. Donât works
Delete this forms in DataLinkv06.mdb and import form DataLinkv04.mdb where this forms are ok but, donât works, this form imports bad. (Try to do this several times).
Delete this forms in DataLinkv04 .mdb and import form DataLinkv04.mdb where this forms are ok but, itâs works, but the central error donât fix because we uses an old version. Up to Here look like that the last version donât have solution.
Decompiled and Compile DataLinkv06.mdb but this donât works.
Compact and repair DataLinkv06.mdb but this donât works.
Open the form and create the reference with de sub form but this donât works
Create a new form and copy the controls and de
VB code but, donât work
Create the sub form and copy the controls and de
VB code and create the new references but, donât work.
Test the query associate to this sub form and works ok.
Replicate the database donât works.
User Software to fix this database like (AccessFix, Recovery for access, Access Workbench) donât fix.
Delete all link tables and create then in a new database and import all queries, forms, reports, macros and modules, but the problems are still there.
Change security options.
Try to modified system tables like (MsysObjects, MSysACEs, MSysAccessStorage) because there are entries like ~sq_cfRptAbrvHV ~sq_ccbo31 and message with error.
Other form to change the ODBC information on link tables is delete and create all link table every time donât works.
Observation
If we don't relink the tables to TEST1 this form are ok.
Fix relink table, but this code is ok, donât find the mistake yet if this is the problem.
Fix this forms and its ok. Donât have nothing wrong, this forms works before ok.
Compact and Repair donât Works ok
Investigate about Access Limits, because this database is to big. but it's ok.
Decompile and other function to fix donât works not
Investigate about new Service Pack for Access and about MDAC version and this version are ok, I install the Service Pack 2 but this don't fix the problem.
Import this forms in Access 2003 (SO: Windows 2000, Windows XP) but donât works.
Thanks
Regards
Lijandra :)