July 15, 2009 at 6:34 pm
I am using the DBEngine.RegisterDatabase method to create a DSN in a setup module. How would I go about making it so my access application uses that DSN? Is there a way that I can set this at runtime?
Thanks,
Jim
August 13, 2009 at 3:45 pm
Not entirely all my code as I got pieces of it from elsewhere but added the ability to loop through all your linked tables and queries. Hope this helps:
Public Sub ODBCServerSet(strServerName As String, Optional strDatabaseName As String = "MY_DB_NAME")
If gblnErrorHandler Then On Error GoTo dam_odbcserverset
Dim dbData As Database
Dim tblDef As TableDef
Dim qryDef As QueryDef
Dim lngKounter As Long, _
lngInnerKounter As Long
Dim strConnect As String, _
arrConnect() As String, _
arrItem() As String, _
strUserID As String, _
strPasswd As String
Dim blnDisplay As Boolean
If InStr(1, VBA.CStr$(CurrentProject.FullName), "_DEV", vbTextCompare) > 0 Or InStr(1, VBA.CStr$(CurrentProject.FullName), "_RC", vbTextCompare) > 0 Then
blnDisplay = True
Else
blnDisplay = False
End If
If Not blnDisplay Then
Application.Echo False
DoCmd.Hourglass True
End If
strUserID = "MY DB USER NAME"
strPasswd = "MY DB USER PASSWORD"
Set dbData = CurrentDb
dbData.TableDefs.Refresh
For Each tblDef In dbData.TableDefs
With tblDef
If blnDisplay Then Debug.Print "TBL: " & .Name
strConnect = .Connect
If Len(VBA.Trim$(strConnect)) > 0 Then
arrConnect = Split(strConnect, ";")
For lngInnerKounter = LBound(arrConnect) To UBound(arrConnect)
If InStr(1, arrConnect(lngInnerKounter), "=") > 0 Then
arrItem = Split(arrConnect(lngInnerKounter), "=")
Select Case arrItem(0)
Case "SERVER"
If arrItem(1) strServerName Then
arrConnect(lngInnerKounter) = "SERVER=" & StrConv(strServerName, vbProperCase)
End If
Case "DATABASE"
If arrItem(1) strDatabaseName Then
arrConnect(lngInnerKounter) = "DATABASE=" & StrConv(strDatabaseName, vbProperCase)
End If
Case "WSID"
If arrItem(1) Environ("COMPUTERNAME") Then
arrConnect(lngInnerKounter) = "WSID=" & VBA.UCase$(Environ("COMPUTERNAME"))
End If
Case "UID"
If arrItem(1) strUserID Then
arrConnect(lngInnerKounter) = "UID=" & strUserID
End If
Case "PWD"
If arrItem(1) strPasswd Then
arrConnect(lngInnerKounter) = "PWD=" & strPasswd
End If
End Select
End If
Next lngInnerKounter
.Connect = Join(arrConnect, ";")
.RefreshLink
End If
End With
Next
For Each qryDef In dbData.QueryDefs
With qryDef
strConnect = .Connect
If blnDisplay Then Debug.Print "QRY: " & .Name
If Len(VBA.Trim$(strConnect)) > 0 Then
arrConnect = Split(strConnect, ";")
For lngInnerKounter = LBound(arrConnect) To UBound(arrConnect)
If InStr(1, arrConnect(lngInnerKounter), "=") > 0 Then
arrItem = Split(arrConnect(lngInnerKounter), "=")
Select Case arrItem(0)
Case "SERVER"
If arrItem(1) strServerName Then
arrConnect(lngInnerKounter) = "SERVER=" & StrConv(strServerName, vbProperCase)
End If
Case "DATABASE"
If arrItem(1) strDatabaseName Then
arrConnect(lngInnerKounter) = "DATABASE=" & StrConv(strDatabaseName, vbProperCase)
End If
Case "WSID"
If arrItem(1) Environ("COMPUTERNAME") Then
arrConnect(lngInnerKounter) = "WSID=" & VBA.UCase$(Environ("COMPUTERNAME"))
End If
Case "UID"
If arrItem(1) strUserID Then
arrConnect(lngInnerKounter) = "UID=" & strUserID
End If
Case "PWD"
If arrItem(1) strPasswd Then
arrConnect(lngInnerKounter) = "PWD=" & strPasswd
End If
End Select
End If
Next lngInnerKounter
.Connect = Join(arrConnect, ";")
'.RefreshLink
End If
End With
Next
dbData.TableDefs.Refresh
If blnDisplay Then Call ODBCDisplay
Set tblDef = Nothing
Set qryDef = Nothing
Set dbData = Nothing
If Not blnDisplay Then
Application.Echo True
DoCmd.Hourglass False
End If
Exit Sub
dam_odbcserverset:
ErrorHandler.SaveError Err.Number, Err.Description, Err.Source, "DataAccess::ODBCServerSet", "SERVER=" & strServerName & "DATABASE=" & strDatabaseName
Set tblDef = Nothing
Set qryDef = Nothing
Set dbData = Nothing
Application.Echo True
DoCmd.Hourglass False
End Sub
August 14, 2009 at 1:31 am
Have you tried the SQLConfigDataSource API? http://support.microsoft.com/kb/171146
August 14, 2009 at 12:38 pm
If all your tables / queries connect to a SQL Server database, you could run this from an AutoExec macro before you attempt any data access from the server:
Function SQL_RelinkDatabase()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim qdf As DAO.QueryDef
Dim s As String
s = "your ODBC connection string goes here"
Set db = CurrentDb
For Each tdf In db.TableDefs
If tdf.Connect > "" Then
tdf.Connect = s
tdf.RefreshLink
End If
Next tdf
For Each qdf In db.QueryDefs
If qdf.Connect > "" Then
qdf.Connect = s
End If
Next qdf
Set db = Nothing
End Function
August 14, 2009 at 1:24 pm
Hi Bill, what does
.Connect > ""
test?
August 14, 2009 at 1:47 pm
Is tests to see if the table or query has a connection string. If the table is a linked table or the query is a SQL pass-thru query, the existing connection will be in the .Connect property.
Local Access tables or native Access queries will have .Connect = "".
August 14, 2009 at 2:27 pm
but... for example... If qdf.Connect > "" Then it means the .Connect property already has a connection string so why substitute it with
qdf.Connect = s
?
August 14, 2009 at 5:34 pm
As I understood the OP, he has written an Access application that uses linked SQL Server tables.
Now, he is creating a setup program & is using RegisterDatabase to create a DSN on the target machine.
However, the server, db name etc. will be different when the app is installed, so he wants to automatically relink everything when the app opens.
That's the purpose of my code - to change all the existing links.
Jim (OP) - is this what you need?
Viewing 8 posts - 1 through 7 (of 7 total)
You must be logged in to reply to this topic. Login to reply