Wrox Programmer Forums
Access VBA Discuss using VBA for Access programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
Old August 16th, 2006, 12:48 PM
Registered User
Join Date: Aug 2006
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default Form and SubForm stop work

     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
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
    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
                    collTables.Add Item:=.Name & .Connect, Key:=.Name
                End If
            End If
        End With
    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
            If strNewPath <> vbNullString Then
                'Try this first
                strDBPath = strNewPath
                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
                        collTbls.Remove (.Name)
                End With
                err.Raise cERR_NOREMOTETABLE
            End If
        End If
    fRefreshLinks = True
    varRet = SysCmd(acSysCmdClearStatus)
    MsgBox "All Access tables were successfully reconnected.", _
            vbInformation + vbOKOnly, _

    Set collTbls = Nothing
    Set tdfLocal = Nothing
    Set dbLink = Nothing
    Set dbCurr = Nothing
    Exit Function
    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
            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))
        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
SQLCONNECTSTRING = "ODBC;DSN=" & strWSID & ";APP=Microsoft Office 2003;WSID=lijandra;DATABASE=DataLink;Network=DBMSS OCN;Trusted_Connection=Yes"

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.

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.

Lijandra :)

Similar Threads
Thread Thread Starter Forum Replies Last Post
Stop Tab out of subform medic7103 Access 1 April 22nd, 2007 03:44 PM
Printing a form with a subform in it jcalfg Access 1 July 25th, 2006 03:40 PM
set form on subform gigi79 Access 2 May 23rd, 2006 03:08 PM
How to link form and subform method Access 1 July 30th, 2005 02:19 AM
How to stop user from view js code but still work bekim Javascript How-To 4 January 7th, 2005 09:08 PM

Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.