Deleted and relinked ODBC table but Access still wants old ODBC table.

[sparkbyte]

I am pulling my hair out!!!!

I have tried verything I know to try.

I had a table called Contacts_Table that became ContactsTable . (NO Problems)

started migrating multiple Access DB into one SQL DB on the backend so I created schema's for each front-end.

dbo.ContactsTable became eWRTs.ContactsTable still no issues with the Access 2010 front-end.

renamed eWRTs.ContactsTable to eWRTs.Contacts, now every time Access tries to save anything to the contacts table I get an ODBC error saying it can't find the eWRTs.ContactsTable.

When the FE is launched ALL ODBC linked tables are deleted and relinked.

Updated the Contacts input/modify form to the new table name and it still tries to save to the old table name.

I have tried changing the RecordSource to an imbeded query, SAVE still looks for the old table.

Created new query for the form and set the recordsource to the new query. Still it looks for the old table name.

Created new contacts form from scratch. still save looks for the old ODBC table name.

created new blank Access DB and imported the FE forms, ect. into the blank.
problem is still there.

set the recordsource to the query in the open form event. still looks for the old ODBC table name.

This happens regardless of whether Access is using the OLD {SQL Server} client or the NEWER {SQL Server Native Client V10.0}.

Also, does not matter if the client is XP or Windows 7.


Help I am going to be bald soon!!!

Here is the module that I put together from waaay to many sources to remember.

Option Compare Database
Const HKEY_LOCAL_MACHINE = &H80000002

Public Function LinkAllTables(Server As Variant, Database As Variant, _
                            OverwriteIfExists As Boolean, _
                            Optional Schema As Variant)
                            If IsMissing(Schema) = True Then Schema = "dbo"

On Error GoTo Error_Handler

    'Usage Example:  Call linkalltables("mySQLserver","mySQLdatabase", true, "schema")
    
    ' (link all tables in database "SQLDB" on SQL Server Instance SQO01,
    ' in the 'dbo' and 'HR' schema's overwriting any existing linked tables.

    'This will also update the link if the underlying table definition has been modified.

    Dim rsTableList As New ADODB.Recordset
    Dim sqlTableList As String

    sqlTableList = "SELECT [TABLE_SCHEMA] + '.' + [TABLE_NAME] as TableName"
    sqlTableList = sqlTableList + " FROM [INFORMATION_SCHEMA].[TABLES]"
    sqlTableList = sqlTableList + " INNER JOIN [sys].[all_objects]"
    sqlTableList = sqlTableList + " ON [INFORMATION_SCHEMA].[TABLES].TABLE_NAME = [sys].[all_objects].[name]"
'   sqlTableList = sqlTableList + " WHERE [sys].[all_objects].[type] IN ('U','V')"
    sqlTableList = sqlTableList + " WHERE [sys].[all_objects].[type] IN ('U')"
    sqlTableList = sqlTableList + " AND [sys].[all_objects].[is_ms_shipped]<>1"
    sqlTableList = sqlTableList + " AND [sys].[all_objects].[name] <> 'sysdiagrams'"
    sqlTableList = sqlTableList + " ORDER BY [TABLE_SCHEMA], [TABLE_NAME]"
    
    Debug.Print "------------------------------------------------------------------------"
    Debug.Print BuildADOConnectionString(Server, Database)
    
    rsTableList.Open sqlTableList, BuildADOConnectionString(Server, Database)
    
    If rsTableList.State = adStateClosed Then
        rsTableList.Open sqlTableList, BuildADOConnectionString(Server, Database)
        Debug.Print BuildADOConnectionString(Server, Database)
    End If
       
Function_Continue:

'    Debug.Print "------------------------------------------------------------------------"
    Dim arrSchema As Variant
    While Not rsTableList.EOF
        arrSchema = Split(rsTableList("TableName"), ".", , vbTextCompare)
        If arrSchema(0) = Schema Then
            If LinkTable(arrSchema(1), Server, Database, rsTableList("TableName"), OverwriteIfExists) Then
'                Debug.Print "Linking " & arrSchema(0) & " table " & arrSchema(1)
            End If
        End If
    rsTableList.MoveNext
    Wend

Error_Handler:
    If Err.Number = -2147467259 Then
        rsTableList.Open sqlTableList, BuildADOConnectionString(Server, Database)
        GoTo Function_Continue
    End If
    
    GoTo Function_Quit

Function_End:
    On Error GoTo Function_Quit
    rsTableList.Close
    GoTo Function_Quit
    
Function_Quit:
    Debug.Print "------------------------------------------------------------------------"
    Set rsTableList = Nothing
    
End Function

Function LinkTable(LinkedTableAlias As Variant, Server As Variant, Database As Variant, SourceTableName As Variant, OverwriteIfExists As Boolean)
On Error GoTo Error_Handler

    'This method will also update the link if the underlying table definition has been modified.

    'The overwrite parameter will cause it to re-map/refresh the link for LinktedTable Alias, but only if it was already a linked table.
    ' it will not overwrite an existing query or local table with the name specified in LinkedTableAlias.

    'Links to a SQL Server table without the need to set up a DSN in the ODBC Console.
    Dim dbsCurrent As Database
    Dim tdfLinked As TableDef

    ' Open a database to which a linked table can be appended.
    Set dbsCurrent = CurrentDb()

    'Check for and deal with the scenario of the table alias already existing
    If TableNameInUse(LinkedTableAlias) Then

        If (Not OverwriteIfExists) Then
'            Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite existing table."
            Exit Function
        End If

        'delete existing table, but only if it is a linked table
        If IsLinkedTable(LinkedTableAlias) Then
            dbsCurrent.TableDefs.Delete LinkedTableAlias
            dbsCurrent.TableDefs.Refresh
        Else
'            Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite an existing query or local table."
            Exit Function
        End If
    End If

    'Create a linked table
    Set tdfLinked = dbsCurrent.CreateTableDef(LinkedTableAlias)
    tdfLinked.SourceTableName = SourceTableName
    tdfLinked.Connect = "ODBC;" & BuildADOConnectionString(Server, Database)

Function_Continue:
    dbsCurrent.TableDefs.Append tdfLinked
    GoTo Function_End:
   
Error_Handler:
'    Debug.Print "ErrorNumber: " & Err.Number & vbCrLf & "ErrorDesc: " & Err.Description & vbCrLf & "ErrorSource: " & Err.Source
    
    Select Case (Err.Number)
        Case (3151)
            Err.Clear
            tdfLinked.Connect = "ODBC;" & BuildADOConnectionString(Server, Database)
            GoTo Function_Continue
    
        Case (-2147467259)
            Err.Clear
            tdfLinked.Connect = "ODBC;" & BuildADOConnectionString(Server, Database)
            GoTo Function_Continue
   
        Case (3626) 'too many indexes on source table for Access
            Err.Clear
            On Error GoTo 0
            If LinkTable(LinkedTableAlias, Server, Database, "vw" & SourceTableName, OverwriteIfExists) Then
'                Debug.Print "Can't link directly to table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Linked to view '" & "vw" & SourceTableName & "' instead."
                LinkTable = True
            Else
'                Debug.Print "Can't link table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Create a view named '" & "vw" & SourceTableName & "' that selects all rows/columns from '" & SourceTableName & "' and try again to circumvent this."
                LinkTable = False
                Exit Function
            End If
    End Select
        
Function_End:
    tdfLinked.RefreshLink
    LinkTable = True
    GoTo Function_Quit
    
Function_Quit:
    Set tdfLinked = Nothing
    
End Function

Function TableNameInUse(TableName As Variant) As Boolean
    'check for local tables, linked tables and queries (they all share the same namespace)
    TableNameInUse = DCount("*", "MSYSObjects", "(Type = 4 or type=1 or type=5) AND [Name]='" & TableName & "'") > 0
End Function

Function IsLinkedTable(TableName As Variant) As Boolean
    IsLinkedTable = DCount("*", "MSYSObjects", "(Type = 4) AND [Name]='" & TableName & "'") > 0
End Function

Public Function DeleteODBCTableNames(Optional stLocalTableName As String)
On Error GoTo Err_DeleteODBCTableNames

Dim dbs As Database
Dim tdf As TableDef
Dim i As Integer
Dim prpLoop As Property

Set dbs = CurrentDb

If Len(stLocalTableName) = 0 Then
    For i = dbs.TableDefs.Count - 1 To 0 Step -1
        Set tdf = dbs.TableDefs(i)
'            Debug.Print tdf.Name & " : " & tdf.SourceTableName
            If (tdf.Attributes And dbAttachedODBC) Then
'                    Debug.Print "Deleting Linked Table:" & vbTab & tdf.Name
                    dbs.TableDefs.Delete (tdf.Name)
            End If
    Next i
Else
'    Debug.Print "Local Table:  " & vbTab & stLocalTableName
    dbs.TableDefs.Delete (stLocalTableName)
End If

dbs.Close
Set dbs = Nothing

Exit_DeleteODBCTableNames:
Exit Function

Err_DeleteODBCTableNames:
MsgBox ("Error # " & str(Err.Number) & " was generated by " & Err.Source & Chr(13) & Err.Description)
Resume Exit_DeleteODBCTableNames
End Function

Public Function BuildADOConnectionString(Server As Variant, DBName As Variant) As String

strComputer = "."

Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
                    & strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers"
objRegistry.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes

'Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
'strKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers"
'objRegistry.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes
 
For i = 0 To UBound(arrValueNames)
    strValueName = arrValueNames(i)
    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
    
    If InStr(1, arrValueNames(i), "SQL Server Native Client") Then
        Dim arrClient() As String
        Dim strVer As String
        arrClient = Split(arrValueNames(i), " ")
            For j = LBound(arrClient) To UBound(arrClient)
                If IsNumeric(arrClient(j)) Then
                    strVer = arrClient(j)
                End If
            Next
        
        BuildADOConnectionString = "Driver={SQL Server Native Client " & strVer & "};" & _
                                   "Server=" & Server & _
                                   ";APP=" & APP_TITLE & ";" & _
                                   "Database=" & DBName & ";" & _
                                   "TRUSTED_CONNECTION=yes;" & _
                                   "MultipleActiveResultSets = FALSE;"
    Else
    
'        MsgBox "This application requires the SQL Server Native Client." & _
'                vbCrLf & "Please contact the Service Desk at 888-220-5228" & _
'                vbCrLf & "turn in a ticket to have the SQL Server 2008 R2 Client installed.", _
'                vbCritical + vbOKOnly + vbMsgBoxSetForeground, "ODBC Version Error"
        
        BuildADOConnectionString = "Driver={SQL Server};" & _
                                   "Server=" & Server & ";" & _
                                   "APP=" & APP_TITLE & ";" & _
                                   "Database=" & DBName & ";" & _
                                   "TRUSTED_CONNECTION=yes;" & _
                                   "MultipleActiveResultSets = True;"
    End If
Next

End Function

Public Function GetConnectionString(strTable)
    Dim dbs As Database
    Set dbs = CurrentDb
    
    Dim strValue As String
    
    strValue = dbs.TableDefs(strTable).Connect
    GetConnectionString = strValue
'    Debug.Print strValue
End Function

Public Function LogODBCclient()

    Dim dbs As DAO.Database
    Dim strSQLlookup
    Dim strSQLInsert
    Dim strSQLUpdate
    Dim strMachineName
    Dim strloginID
    Set dbs = CurrentDb
    
    strloginID = GetNetworkUserName()
    strMachineName = ComputerName()


If TableNameInUse("SQLVersion") = True Then
        
    strSQLlookup = DLookup("SQLversion_PK", "[SQLVersion]", _
                   "LoginID = '" & strloginID & "'" & _
                   " AND Workstation = '" & GetMachineName() & "'")
                   
'    Debug.Print strSQLlookup
'    Debug.Print "**********************************************************************"
    
    If IsNull(strSQLlookup) Then
        strSQLInsert = "INSERT INTO [SQLVersion]" & vbCrLf & _
                "(LoginID, UserFullName, Workstation, Application, ODBCclient, AppDB, SQLserver, CaptureDT)" & vbCrLf & _
                 "VALUES" & vbCrLf & "(" & _
                 "'" & GetNetworkUserName() & "'" & "," & _
                 "'" & GetUserFullName() & "'" & "," & _
                 "'" & strMachineName & "'" & "," & _
                 "'" & APP_TITLE & "'" & "," & _
                 "'" & GetODBCdriver("activity") & "'" & "," & _
                 "'" & GetDataPath("activity") & "'" & "," & _
                 "'" & GetODBCServer("activity") & "'" & "," & _
                 "#" & Now() & "#" & ");"
                 
'        Debug.Print strSQLInsert
        dbs.Execute strSQLInsert, dbSeeChanges
    Else
        strSQLUpdate = "Update [SQLVersion] " & vbCrLf & _
                       "SET" & vbCrLf & _
                       "LoginID = '" & GetNetworkUserName() & "'," & vbCrLf & _
                       "UserFullName = '" & GetUserFullName() & "'," & vbCrLf & _
                       "Application = '" & APP_TITLE & "'," & vbCrLf & _
                       "ODBCclient = '" & GetODBCdriver("activity") & "'," & vbCrLf & _
                       "AppDB = '" & GetDataPath("activity") & "'," & vbCrLf & _
                       "SQLserver = '" & GetODBCServer("activity") & "'," & vbCrLf & _
                       "CaptureDT = #" & Now() & "# " & vbCrLf & _
                       "Where SQLversion_PK = " & strSQLlookup & ";"

'        Debug.Print strSQLUpdate
        dbs.Execute strSQLUpdate, dbSeeChanges
    End If
Else
    Debug.Print "Cannot Log SQL information." & vbCrLf & _
                "Table SQLversion is not linked."
End If

End Function

Function GetODBCdriver(strTable As String)
Dim arrConnectionString As Variant
Dim i As Integer
Dim arrDriver As Variant
Dim x As Integer

    arrConnectionString = Split(GetConnectionString(strTable), ";")
    
    For i = LBound(arrConnectionString) To UBound(arrConnectionString)
        If InStr(1, arrConnectionString(i), "DRIVER=", vbTextCompare) Then
           arrDriver = Split(arrConnectionString(i), "=")
            For x = LBound(arrDriver) To UBound(arrDriver)
                If InStr(1, arrDriver(x), "sql", vbTextCompare) Then
                    GetODBCdriver = arrDriver(x)
'                    Debug.Print arrDriver(x)
                End If
            Next x
        End If
    Next i
    
End Function

Function GetODBCServer(strTable As String)
Dim arrConnectionString As Variant
Dim i As Integer
Dim arrDriver As Variant
Dim x As Integer

    arrConnectionString = Split(GetConnectionString(strTable), ";")
    
    For i = LBound(arrConnectionString) To UBound(arrConnectionString)
        If InStr(1, arrConnectionString(i), "SERVER=", vbTextCompare) Then
           arrDriver = Split(arrConnectionString(i), "=")
            For x = LBound(arrDriver) To UBound(arrDriver)
'                If InStr(1, arrDriver(x), "sql", vbTextCompare) Then
                    GetODBCServer1 = arrDriver(x)
'                    Debug.Print arrDriver(x)
'                End If
            Next x
        End If
    Next i
    
End Function

Function GetODBCDatabase(strTable As String)
Dim arrConnectionString As Variant
Dim i As Integer
Dim arrDriver As Variant
Dim x As Integer

    arrConnectionString = Split(GetConnectionString(strTable), ";")
    
    For i = LBound(arrConnectionString) To UBound(arrConnectionString)
        If InStr(1, arrConnectionString(i), "DATABASE=", vbTextCompare) Then
           arrDriver = Split(arrConnectionString(i), "=")
            For x = LBound(arrDriver) To UBound(arrDriver)
'                If InStr(1, arrDriver(x), "sql", vbTextCompare) Then
                    GetODBCDatabase = arrDriver(x)
'                    Debug.Print arrDriver(x)
'                End If
            Next x
        End If
    Next i
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : ListODBCTableProps
' Author    : Patrick Wood  [URL unfurl="true"]http://gainingaccess.net[/URL]
' Date      : 5/28/2011
' Purpose   : List the Table Properties of ODBC linked tables
'---------------------------------------------------------------------------------------

Function ListODBCTableProps()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim prp As DAO.Property

    Set db = CurrentDb

    'Loop through the TableDefs Collection
    For Each tdf In db.TableDefs
        'Verify the table is an ODBC linked table
        If Left$(tdf.Connect, 5) = "ODBC;" Then
            Debug.Print "----------------------------------------"
            For Each prp In tdf.Properties
               'Skip NameMap and GUID which are Binary Type Properties here
                If prp.Name <> "NameMap" And prp.Name <> "GUID" Then
                     Debug.Print prp.Name & ": " & prp.Value
                End If
            Next prp
        End If
    Next tdf

    Set tdf = Nothing
    Set db = Nothing
End Function

Function delODBCtables()
   'delete any tables where connection property has ODBC in it
   Dim tdf As DAO.TableDef
   
StartAgain:
     For Each tdf In CurrentDb.TableDefs
        If InStr(1, tdf.Connect, "ODBC") > 0 Then
            Debug.Print tdf.Name
           DoCmd.DeleteObject acTable, tdf.Name
           GoTo StartAgain
        End If
     Next tdf
     Set tdf = Nothing
     
 End Function

Thanks

John Fuhrman

 

[trevil620]

Since I don't have all the functions your code is calling, I am sending you some code we put together several years ago (hopefully it is complete enough for you to get the idea).
Here is what the code was intended for:
1. We migrated our backend from Access to SQL Server.
2. We deploy changes to our Access frontend to 70+ different servers around the world -- each with a unique name. When we do that, we need to automatically relink from our 'test' environment, to their production environment.
3. Under certain conditions (i.e. first time new frontend is opened), we execute code to relink.
4. But before we try to relink, we confirm we can actually make the connection to SQL Server.
5. After the 'planned' relink, we confirm it actually took place.
6. I realize your parameters/settings are different, but you may find something useful in the code.

Function ReLink_SQLSERVER_Tables()
Dim Cat         As ADOX.Catalog
Dim tdfs        As ADOX.Tables
Dim tdf         As ADOX.Table
Dim dbs         As DAO.Database
Dim tdf2        As DAO.TableDef
Dim cnConn      As ADODB.Connection
Dim strTableName    As String
Dim strConn         As String
Dim aTables(200, 2)
Dim iTables         As Integer
Dim i               As Integer
Dim strDisplay      As String

1000    On Error GoTo ERROR_HANDLER

1020    If GetConnection(gvstr_SQLServer_Name, gvstr_SQLServer_Database, _
                cnConn, adUseServer, True, False) = False Then
1030        MsgBox "Unable to connect to SQL Server database in 'Utilities: ReLink_SQLSERVER_Tables'"
1040    End If
        
1050    DoCmd.OpenForm "frmWait", acNormal, , , , , "frmSignin"
1060    DoEvents
        
1100    Set Cat = New ADOX.Catalog
1120    Set Cat.ActiveConnection = cnConn
        Debug.Print cnConn
1140    For Each tdf In Cat.Tables
1160        If tdf.Type = "TABLE" Or (tdf.Type = "VIEW" And Left(tdf.Name, 3) = "vue") Then
1180            If tdf.Name <> "xxxxxx" _
                    And Left(tdf.Name, 4) <> "Msys" Then
1260                    Debug.Print tdf.Name & vbTab & tdf.Type
1280                strConn = "ODBC;DRIVER=SQL Server;SERVER=" & gvstr_SQLServer_Name & ";" & _
                            "DATABASE=" & gvstr_SQLServer_Database & ";" & _
                            "UID=UUUUUU;PWD=PASSWORD”)& ";" & _
                            "TABLE=dbo." & tdf.Name
1290                strDisplay = "ODBC;DRIVER=SQL Server;SERVER=" & gvstr_SQLServer_Name & ";" & _
                            "DATABASE=" & gvstr_SQLServer_Database & ";" & _
                            "UID=S*********t;PWD=***************;" & _
                            "TABLE=dbo." & tdf.Name

1320                Set tdf2 = CurrentDb.CreateTableDef(tdf.Name, dbAttachSavePWD, tdf.Name, strConn)
1340                Write_To_Log "Relink table: " & tdf.Name & vbTab & "To: " & strDisplay
1360                CurrentDb.TableDefs.Append tdf2
1380            End If
1400        Else
1420            Debug.Print tdf.Name & vbTab & tdf.Type
1440        End If
1460    Next tdf
                
        ' Let's check ALL TDF's for proper links
1480    Write_To_Log " "
1500    Write_To_Log " "
1520    Set dbs = CurrentDb
1540    For Each tdf2 In dbs.TableDefs
1560        strTableName = tdf2.Name
'1580        Debug.Print tdf2.Name & vbTab & tdf2.Connect
1600        If tdf2.Connect <> "" Then
1620            If InStr(1, tdf2.Connect, gvstr_SQLServer_Name & ";") = 0 Then
                    '  mask the password from being displayed in the FPOpen.txt log file
1630                strDisplay = tdf2.Connect
1631                i = InStr(1, strDisplay, "PWD=")
1632                If i > 0 Then
1633                    strDisplay = Left(strDisplay, i + 4) & "********" & Mid(strDisplay, i + 15, 999)
1634                End If
1640                Write_To_Log "**** " & strTableName & " linked to wrong server: " & strDisplay

1660                strConn = "ODBC;DRIVER=SQL Server;SERVER=" & gvstr_SQLServer_Name & ";" & _
                              "DATABASE=" & gvstr_SQLServer_Database & ";" & _
                              "UID=UUUUUUU;PWD=PASSWORD;" & _
                              "TABLE=dbo." & strTableName
1700                dbs.TableDefs.Delete strTableName
1720                Set tdf2 = dbs.CreateTableDef(strTableName, dbAttachSavePWD, strTableName, strConn)
1740                dbs.TableDefs.Append tdf2
1760            End If
1770            If strTableName <> "dtproperties" And strTableName <> "sysdiagrams" Then
1780                If InStr(1, tdf2.Connect, "DATABASE=" & gvstr_SQLServer_Database) = 0 Then
1800                    MsgBox "After Relink - wrong Database for: " & tdf2.Name
1810                End If
1820            End If
1840        End If
1860    Next tdf2
1880    Set tdf2 = Nothing
1900    dbs.Close
1920    Set dbs = Nothing
1921    cnConn.Close
1922    Set cnConn = Nothing
1923    Set Cat = Nothing
1924    Set tdf = Nothing

        'MsgBox "Finished Attaching SQL Server Tables"
1940 Proc_Exit:

1950    DoCmd.Close acForm, "frmWait"
1960    DoEvents

1970    Exit Function

1980 ERROR_HANDLER:
2000    Err.Source = "Module_Utilities: ReLink_SQLSERVER_Tables  at Line: " & Erl
2020    If Err.Number = 3010 And InStr(1, Err.Description, "already exists") > 0 Then
            Debug.Print "    Error - delete tdf: " & tdf.Name
2040        CurrentDb.TableDefs.Delete tdf.Name
2060        Write_To_Log "         " & tdf.Name & vbTab & " already exists; delete tdf and then connect"
2080        Resume
2100    ElseIf Err.Number = 3298 Then
2120        Debug.Print Err.Number & vbTab & Err.Description
2140        Write_To_Log "  *******" & tdf.Name & vbTab & " Error 3298 ????"
2160        Resume Next
2180    End If
2200    Debug.Print Err.Number & vbTab & Err.Description
2220    MsgBox Err.Number & vbCrLf & Err.Description & vbCrLf & Err.Source
2240    Resume Proc_Exit
2260    Resume Next
2280    Resume
End Function

Public Function GetConnection(ByVal strDSN As String, _
        ByVal strDatabase As String, _
        ByRef cnLocal As ADODB.Connection, _
        ByVal CursorLoc As CursorLocationEnum, _
        ByVal UsePassword As Boolean, _
        ByVal blnTrusted As Boolean) As Boolean
        
Dim intWaitDuration     As Integer
Dim strConnectString    As String
Dim strDisplay          As String

Const CURRENT_METHOD As String = "GetConnection"
1000    On Error GoTo ERROR_HANDLER
1020    GetConnection = False
1040    intWaitDuration = 60     ' # of Minutes to wait
1060 Retry_Connection:
1080    If cnLocal Is Nothing Then Set cnLocal = New ADODB.Connection
1100    If cnLocal.State = adStateOpen Then
            Write_To_Log "Connection already open -- -will not reopen!!"
1120        GetConnection = True
1140        GoTo Proc_Exit
1160    End If
'2/3/2010 CHange to use Userid & Password:   Remove 'Trusted_Connection=yes
'             Add User Id=xxxxxx;Password=yyyyyyy;
1180    With cnLocal
1190        If blnTrusted = True Then
1200            strConnectString = "Driver={SQL Server};" & _
                                    "Server=" & strDSN & ";" & _
                                    "Database=" & strDatabase & ";" & _
                                    "Trusted_Connection=yes"
1210        Else
1220            strConnectString = "Driver={SQL Server};" & _
                                    "Server=" & strDSN & ";" & _
                                    "Database=" & strDatabase & ";" & _
                                    "User Id=UUUUUU;Password=PASSWORD”)& ""

1225            strDisplay = "Driver={SQL Server};" & _
                                    "Server=" & strDSN & ";" & _
                                    "Database=" & strDatabase & ";" & _
                                    "User Id=S*********t;Password=****************"

1230        End If
            Write_To_Log "Will use Conn String: " & strDisplay
1270        .ConnectionString = strConnectString
1280        .CursorLocation = CursorLoc
1300        .Open
1320    End With
1340    GetConnection = True
1360 Proc_Exit:
1380    Exit Function
1400 ERROR_HANDLER:
1460 Debug.Print Err.Number & vbCrLf & Err.Description

1480    Err.Source = "Module_Utilities: GetConnection  at Line: " & Erl
1500    DocAndShowError
'1430    Write_To_Log strError
1520    Resume Proc_Exit
1540    Resume Next
1560    Resume
End Function

 

[sparkbyte]

Thank you very much.

It will take a couple of days to go through this and see if I can integrate it into my solution.

It interesting how you use line numbers.

Thanks again.

John Fuhrman

Thanks

John Fuhrman

 

[sparkbyte]

Why did you change from AD trusted connections?

Thanks

John Fuhrman

 

[trevil620]

Hi John, can't remember why we went with UID & PWD versus trusted conn - it was 4/5 years ago.
RE line #'S, I inherited a massive Access application that was just being released to 70 sites; was super slow and many errors. Ugh, there were NO error traps anywhere, so if sub1 called sub2, etc., we had no idea where to look. So I wrote some code to apply error traps and line numbers to every piece of code. Then when an error occurred, we logged it and displayed the exact line of code and subroutine where it happened. Combined results from all 70 sites, sorted by frequency, and bingo - there was our prioritized list of what needs fixing!

Sometimes computer problems are like genealogy... The answer to one problem leads to two more!

 

[sparkbyte]

Hey, just so everyone knows. I found the problem.

I am not sure of what was causing the error, but the fix was to delete the old ContactsTable and recreate it as Contacts then migrate in the production data.

Also, trevil620, would it be possible for you to shre the code you created for your error trapping? I have about 20 different Access applications that I am in the process of merging the data and updating the front ends and I think your code could save a lot of time.

Thanks
John F.

Thanks

John Fuhrman

 

[trevil620]

out of town till Monday.. will send the code then..

The speculative judgment of the quality of an answer is based directly on … what was the question again?

 

[sparkbyte]

Thanks!!!

Thanks

John Fuhrman

 

[trevil620]

John, I just got home; I assume you want a copy of the program that inserts error traps into VBA code, or is it that you just want to see what the code looks like?

The speculative judgment of the quality of an answer is based directly on … what was the question again?

 

[sparkbyte]

Both actually.

If you feel comfortable letting me using it. I got roped into migrating Access DB's to SQL Server and in the process inherited the Access front ends and all the VBA. I have only been doing this for about 2 years and programming really was not my forte'. I was a network admin mainly and could do light programming or scripting when needed.

Now that this seems to be all I am doing I am having to cram and glean as much as possible of examples and a lot of trial and error. One of the ereas that has been particularly tough has been error trapping because everyone has a different idea of how to do it. I particularly like you code with line numbers because as you pointed out, you can quickly find the offending code seqments.



Thanks

John Fuhrman

 

[trevil620]

Yes, I can send you the program. I want to make sure it will function correctly in your environment (ADO vs DAO), so I am doing some testing. Re converting to SQL Server, I went thru the same process years ago -- so again I wrote code that would convert all the DAO stuff to ADO, plus all the other differences.

When all else fails, manipulate the data.

 

[sparkbyte]

Thanks TONS!!!! I look forward to seeing your solution.

Thanks

John Fuhrman

 

[trevil620]

Hi John, sorry for delay - was working out instructions & removing components not associated with 'Adding Error Traps & Inserting Line Numbers in VBA Code'
Here is a link to Dropbox where you will find a document explaining how to use, and an .mdb file with all of the code; there is also the same .mdb, but named as .txt in case your AntiVirus software prevents download of .mdb.

https://www.dropbox.com/sh/oiz6vullprmt0s5/mIsKvBQvN7

I would appreciate it if you encounter any issues, to please let me know so I can modify the code to handle those situations.
Thank you, and good luck. Wayne

When all else fails, manipulate the data.