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.
Thanks
John Fuhrman
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.
Code:
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