Changing SQL connection information for DSN-less Access frontend - sql-server

I've got a mission-critical Access 2003 database that changed from a local MDB, to an MDB frontend with the backend on MS SQL Server 2005, using the Microsoft SQL Server Database Migration Assistant (SSMA) software.
Now, I need to permanently change the server that the tables are linked to from an IP address (which is changing soon) to a hostname pointing to the same server. The server itself is not changing, just the connection string.
It's a DSN-less connection, so the ODBC info is contained within the Access MDB file. If I try to refresh the table links within Access, it prompts me for a DSN (which I don't want to use).
I've done some Googling, and I've found several scraps of code to have it update itself each time the program launches. But, I'm worried that that could potentially introduce problems or delays for the users. Is that my best option, or is there some trick to permanently change the connection string stored within the MDB?

The following code has served me well for years:
Function LinkTable(DbName As String, SrcTblName As String, _
Optional TblName As String = "", _
Optional ServerName As String = DEFAULT_SERVER_NAME, _
Optional DbFormat As String = "ODBC") As Boolean
Dim db As dao.Database
Dim TName As String, td As TableDef
On Error GoTo Err_LinkTable
If Len(TblName) = 0 Then
TName = SrcTblName
Else
TName = TblName
End If
'Do not overwrite local tables.'
If DCount("*", "msysObjects", "Type=1 AND Name=" & Qt(TName)) > 0 Then
MsgBox "There is already a local table named " & TName
Exit Function
End If
Set db = CurrentDb
'Drop any linked tables with this name'
If DCount("*", "msysObjects", "Type In (4,6,8) AND Name=" & Qt(TName)) > 0 Then
db.TableDefs.Delete TName
End If
With db
Set td = .CreateTableDef(TName)
td.Connect = BuildConnectString(DbFormat, ServerName, DbName)
td.SourceTableName = SrcTblName
.TableDefs.Append td
.TableDefs.Refresh
LinkTable = True
End With
Exit_LinkTable:
Exit Function
Err_LinkTable:
'Replace following line with call to error logging function'
MsgBox Err.Description
Resume Exit_LinkTable
End Function
Private Function BuildConnectString(DbFormat As String, _
ServerName As String, _
DbName As String, _
Optional SQLServerLogin As String = "", _
Optional SQLServerPassword As String = "") As String
Select Case DbFormat
Case "NativeClient10"
BuildConnectString = "ODBC;" & _
"Driver={SQL Server Native Client 10.0};" & _
"Server=" & ServerName & ";" & _
"Database=" & DbName & ";"
If Len(SQLServerLogin) > 0 Then
BuildConnectString = BuildConnectString & _
"Uid=" & SQLServerLogin & ";" & _
"Pwd=" & SQLServerPassword & ";"
Else
BuildConnectString = BuildConnectString & _
"Trusted_Connection=Yes;"
End If
Case "ADO"
If Len(ServerName) = 0 Then
BuildConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DbName & ";"
Else
BuildConnectString = "Provider=sqloledb;" & _
"Server=" & ServerName & ";" & _
"Database=" & DbName & ";"
If Len(SQLServerLogin) > 0 Then
BuildConnectString = BuildConnectString & _
"UserID=" & SQLServerLogin & ";" & _
"Password=" & SQLServerPassword & ";"
Else
BuildConnectString = BuildConnectString & _
"Integrated Security=SSPI;"
End If
End If
Case "ODBC"
BuildConnectString = "ODBC;" & _
"Driver={SQL Server};" & _
"Server=" & ServerName & ";" & _
"Database=" & DbName & ";"
If Len(SQLServerLogin) > 0 Then
BuildConnectString = BuildConnectString & _
"Uid=" & SQLServerLogin & ";" & _
"Pwd=" & SQLServerPassword & ";"
Else
BuildConnectString = BuildConnectString & _
"Trusted_Connection=Yes;"
End If
Case "MDB"
BuildConnectString = ";Database=" & DbName
End Select
End Function
Function Qt(Text As Variant) As String
Const QtMark As String = """"
If IsNull(Text) Or IsEmpty(Text) Then
Qt = "Null"
Else
Qt = QtMark & Replace(Text, QtMark, """""") & QtMark
End If
End Function

You can use VBA to alter the .Connect properties for your linked TableDef s.
See this sample from the Immediate window. (I used Replace() simply to split up that long line.)
? Replace(CurrentDb.TableDefs("remote_table").Connect, ";", ";" & vbCrLf)
ODBC;
DRIVER=SQL Server Native Client 10.0;
SERVER=HP64\SQLEXPRESS;
Trusted_Connection=Yes;
APP=Microsoft Office 2003;
WSID=WIN732B;
DATABASE=testbed;
So I could build a new string with a different SERVER, and assign the new string to the TableDef .Connect property.
If this is intended to be a permanent change you should only need to do it one time, not every time you open the database.
When I've done similar connection changes, it has been between different servers. So I deleted the TableDef and re-created it anew, to make sure Access didn't keep any cached meta information about that connection which would now be out of date. However, in your case, you're dealing with the same physical server, just referencing it by name instead of IP. I doubt the cached information would be a concern for you.

Related

Form Button will not run OpenRecordSet VBA

I am trying to use the following VBA code to run a select query in MS Access.
Private Sub ManuReport_Click()
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim StrSQL As String
Set dbs = CurrentDb
strSQL = "SELECT " & _
"dbo_VENDOR1.ITEM_NO," & _
"dbo_VENDOR1.ITEM_PRICE," & _
"dbo_VENDOR2.ITEM_NO," & _
"dbo_VENDOR2.ITEM_PRICE," & _
"dbo_VENDOR1.MANUFACTURER_ITEM_NO," & _
"dbo_VENDOR1.MANUFACTURER," & _
"dbo_VENDOR1.ITEM_NAME " & _
"From dbo_VENDOR2 " & _
"INNER JOIN dbo_VENDOR1 " & _
"ON dbo_VENDOR2.MANUFACTURER_ITEM_NO = dbo_VENDOR1.MANUFACTURER_ITEM_NO " & _
"WHERE dbo_VENDOR1.MANUFACTURER IN ('MANUFACTURER CODE') " & _
"And dbo_VENDOR1.ITEM_PRICE > dbo_VENDOR2.ITEM_PRICE "
Set rsSQL = dbs.OpenRecordset(strSQL, dbOpenDynaset)
End Sub
I have added this to a button in MSACCES to pull this information from a linked SQL database. I have also been having issues with adding references to form text boxes but I may submit that as a separate question. Whenever I press the button, nothing happens. I don't even get an error screen. I have seen other answers where the issue seems to be how the OpenRecordSet is being used but I am having trouble understanding how I can apply it to this code.
The query itself does work when I create a separate query in Access so I am not sure where the problem is. I reformatted the SQL portion of the code to make it easier to read here, but I have it formatted as a single line in the actual VBA code.
It looks like you want to open a query in Access for display based on a SQL string
The following function will create a query based on the SQL string
Function createQry(qryName As String, sSQL As String)
Dim qdf As QueryDef
' Delete existing query
On Error Resume Next
CurrentDb.QueryDefs.Delete (qryName)
On Error GoTo 0
Set qdf = CurrentDb.CreateQueryDef(qryName, sSQL)
End Function
If you use this code in your posted code like that
Private Sub ManuReport_Click()
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim StrSQL As String
Set dbs = CurrentDb
StrSQL = "SELECT " & _
"dbo_VENDOR1.ITEM_NO," & _
"dbo_VENDOR1.ITEM_PRICE," & _
"dbo_VENDOR2.ITEM_NO," & _
"dbo_VENDOR2.ITEM_PRICE," & _
"dbo_VENDOR1.MANUFACTURER_ITEM_NO," & _
"dbo_VENDOR1.MANUFACTURER," & _
"dbo_VENDOR1.ITEM_NAME " & _
"From dbo_VENDOR2 " & _
"INNER JOIN dbo_VENDOR1 " & _
"ON dbo_VENDOR2.MANUFACTURER_ITEM_NO = dbo_VENDOR1.MANUFACTURER_ITEM_NO " & _
"WHERE dbo_VENDOR1.MANUFACTURER IN ('MANUFACTURER CODE') " & _
"And dbo_VENDOR1.ITEM_PRICE > dbo_VENDOR2.ITEM_PRICE "
'Set rsSQL = dbs.OpenRecordset(StrSQL, dbOpenDynaset)
Dim qryName As String
qryName = "qryTest"
' close the query in case it is open in Access
DoCmd.SetWarnings False
DoCmd.Close acQuery, qryName
DoCmd.SetWarnings True
' Create the query based on the SQL string
createQry qryName, StrSQL
' Open the query in Access for display
DoCmd.OpenQuery qryName, acNormal, acReadOnly
End Sub

Join Excel-Table with SQL Server

My excel-sheet is connected with the data of the sql-server. My clients shall be able to write some columns back to the sql server. The excel-filenames are variable, but the sheeetname and the columns are always static. I tried it with a button and vba but it ends up in error:
Syntaxerror (missing operator) in queryexpression 'UPDATE hbs SET lieferinfo_prio_neu = xlsx.liefer_prio_neu FROM [Provider=SQLOLEDB;Data Source=myserver;Database=mydb;UID=myuser;PWD=mypass;].[tbl_haka_base_size] hbs JOIN [Tabelle3$] xlsx ON xlsx.Artikelnummer'
The internal excel-sheetname is 'Tabelle3', the custom-name is 'Hakabase':
I tried both names without any result.
My code:
Dim excelConn As String
Dim sqlServerConn As String
Dim sqlCommand As String
Dim conn As ADODB.Connection
excelConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& ThisWorkbook.FullName _
& ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=1"";"
sqlServerConn = "[Provider=SQLOLEDB;" _
& "Data Source=myserver;" _
& "Database=mydb;" _
& "UID=ymuser;PWD=mypass;]"
sqlCommand = "UPDATE hbs " _
& " SET lieferinfo_prio_neu = xlsx.liefer_prio_neu " _
& " FROM " & sqlServerConn & ".[tbl_haka_base_size] hbs " _
& " JOIN [Tabelle3$] xlsx " _
& " ON xlsx.Artikelnummer=hbs.artikelnummer"
Set conn = New ADODB.Connection
conn.Open excelConn
conn.Execute sqlCommand
I've also tried to connect to the sqlserver + join the excel-data via openrowset but the server disallowed that:
& " JOIN OPENROWSET('MSDASQL', " _
& " 'Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" _
& ThisWorkbook.FullName & "', 'SELECT * FROM [Tabelle3$]') xlsx" _
Installable ISAM not found
I think I have to create a linked server for each file and enable 'InProcess' for those files. This is not possible because the files are variable.
I've found an alternative solution which is a little bit slow so I still hope someone else is able to answer my question.
The alternative solution is to iterate through each row.. The file got about 150.000 rows and just for 10.000 rows I am waiting about 10 minutes..
Here is the part of iterating
For Each range In sheet.rows: Do
'Continue on headline
If range.Row = 1 Or range.EntireRow.Hidden = True Then
Exit Do
End If
If Len(sheet.Cells(range.Row, lieferInfoColumnIndex)) > 0 Then
articleNumber = sheet.Cells(range.Row, artNoColumnIndex)
UpdateDatabase (articleNumber)
savings = savings + 1
End If
Loop While False: Next range
Here is the slow update function for each row:
Private Sub UpdateDatabase(articleNumber As String)
Dim sqlServerConn As String
Dim sqlCommand As String
Dim conn As ADODB.Connection
sqlServerConn = "Provider=SQLOLEDB;" _
& "Data Source=myserver;" _
& "Database=mydb;" _
& "UID=myuser;PWD=mypass;"
sqlCommand = "UPDATE hbs " _
& "SET lieferinfo_prio_neu=NULL " _
& "FROM [TBL_HAKA_BASE] hbs " _
& "WHERE Artikelnummer=" + articleNumber
Set conn = New ADODB.Connection
conn.Open sqlServerConn
conn.Execute sqlCommand
End Sub

Connecting to SQL Sever From Access Forms Using OleDb

I am working on a project to migrate a Microsoft access backend to a SQL Server backend and my customer insists on using Access to create forms to do any Insert, updates, and deletes. The problem is that he has SQL data tools on his machine and others on his team (without data tools) need to be able to use the forms too. I thought the best way to go about this is to use and OleDb connection through access to connect to the forms so his team can use it and my access knowledge is very limited. All I have so far is what is below
“Driver=SQLOLEDB;Data Source=SomeServer;Initial Catalog=SomeDatabase;Integrated Security=SSPI”
I know the user has creds on the SQL box and can connect through ODBC. We are just having trouble getting the OleDb to work. Any help on how to deploy an OleDB connection in an access form for be greatly appreciated.
Here is the connection we used for SQL Server. It supported using either Trusted Connection, or SQL Server authentication.
Call GetConnection(gvstr_SQLServer_Name, gvstr_SQLServer_Database, _
cnConn, adUseServer, False, False)
If GetConnection(gvstr_SQLServer_Name, gvstr_SQLServer_Database, _
gv_DBS_SQLServer, adUseServer, True, False) = True Then
gvbln_UsingSQLServer = True
DoCmd.Hourglass True
ReLink_SQLSERVER_Tables
Else
gvbln_UsingSQLServer = False
End If
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"
On Error GoTo ERROR_HANDLER
GetConnection = False
intWaitDuration = 60
Retry_Connection:
If cnLocal Is Nothing Then Set cnLocal = New ADODB.Connection
If cnLocal.State = adStateOpen Then
Write_To_Log "Connection already open -- -will not reopen!!"
GetConnection = True
GoTo Proc_Exit
End If
With cnLocal
Debug.Print "Use TRUSTED CONNECTION (ABOVE)"
If gvstr_Workstation = "my-pc" Then
strConnectString = "Driver={SQL Server};" & _
"Server=" & strDSN & ";" & _
"Database=" & strDatabase & ";" & _
"Trusted_Connection=yes"
Else
If blnTrusted = True Then
strConnectString = "Driver={SQL Server};" & _
"Server=" & strDSN & ";" & _
"Database=" & strDatabase & ";" & _
"Trusted_Connection=yes"
Else
strConnectString = "Driver={SQL Server};" & _
"Server=" & strDSN & ";" & _
"Database=" & strDatabase & ";" & _
"User Id=Sql_myuid;Password=ppppp"
strDisplay = "Driver={SQL Server};" & _
"Server=" & strDSN & ";" & _
"Database=" & strDatabase & ";" & _
"User Id=S*********t;Password=****************"
End If
End If
Write_To_Log "Will use Conn String: " & strDisplay
.ConnectionString = strConnectString
.CursorLocation = CursorLoc
.Open
End With
GetConnection = True
Proc_Exit:
Exit Function
ERROR_HANDLER:
Debug.Print Err.Number & vbCrLf & Err.Description
Err.Source = "Module_Utilities: GetConnection at Line: " & Erl
DocAndShowError
Resume Proc_Exit
Resume Next
Resume
End Function

Replacing SQL Data Table with New Data

I have the following code, which uploads data from access to a SQL Server table. The problem is it wont overwrite/replace the table when I try to update it. I get an error saying the table already exists. I need to either add some code to delete the table so the new one can be uploaded or a way to append the new/edited records to the table.
Public Function Update()
DoCmd.TransferDatabase _
acExport, _
"ODBC Database", _
"ODBC;" & _
"Driver={SQL Server Native Client 10.0};" & _
"Server=SERVER;" & _
"Database=DB;" & _
"UID=ID;" & _
"PWD=PW;", _
acTable, _
"CDData", _
"AC_CDData", _
False
End Function
So the AC_CDData table is the one that needs to be replaced
If you want to DROP the existing destination table before transferring the new one then the code would be more like this:
Option Compare Database
Option Explicit
Public Function TransferTableToSqlServer()
Dim cdb As dao.Database, qdf As dao.QueryDef
Dim err As dao.Error
Const DestinationTableName = "AC_CDData"
Const ConnectionString = _
"ODBC;" & _
"Driver={SQL Server Native Client 10.0};" & _
"Server=(local)\SQLEXPRESS;" & _
"Database=YourDatabaseName;" & _
"UID=YourSqlUserId;" & _
"PWD=YourSqlPassword;"
Set cdb = CurrentDb
Set qdf = cdb.CreateQueryDef("")
qdf.Connect = ConnectionString
qdf.sql = _
"IF EXISTS " & _
"(" & _
"SELECT * FROM INFORMATION_SCHEMA.TABLES " & _
"WHERE TABLE_NAME='" & DestinationTableName & " '" & _
") " & _
"DROP TABLE [" & DestinationTableName & "]"
qdf.ReturnsRecords = False
On Error GoTo TransferTableToSqlServer_qdfError
qdf.Execute dbFailOnError
On Error GoTo 0
Set qdf = Nothing
Set cdb = Nothing
DoCmd.TransferDatabase _
acExport, _
"ODBC Database", _
ConnectionString, _
acTable, _
"CDData", _
DestinationTableName, _
False
Exit Function
TransferTableToSqlServer_qdfError:
For Each err In dao.Errors
MsgBox err.Description, vbCritical, "Error " & err.Number
Next
End Function

CLASSIC asp connecting to SQL Express Server 500 server error

Hey all i am trying to get a connection to my SQL server version 10.50.2500 in Classic ASP
My code in the .asp page is (including all connection strings I've tried using):
Set objConn = Server.CreateObject("ADODB.Connection")
Set objRS = Server.CreateObject("ADODB.Recordset")
'objConn.ConnectionString = "Provider={SQL Server};Server=xxx.xxx.xxx.xxx\SQLEXPRESS;Database=JForm;User ID=xxxx;Pwd=xxxx"
'objConn.ConnectionString = "Driver={SQL Server};Server=xxx.xxx.xxx.xxx\SQLEXPRESS;Database=JForm;Uid=xxxx;Pwd=xxxx;"
'objConn.ConnectionString = "Provider=SQLNCLI10;Server=xxx.xxx.xxx.xxx,1433;Database=JForm;Uid=xxxx;Pwd=xxxx;Persist Security Info=True"
'objConn.ConnectionString = "Provider=SQLNCLI;Server=.\SQLEXPRESS;Database=JForm;Uid=xxxx;Pwd=xxxx"
objConn.ConnectionString = "Driver={SQL Server Native Client 10.0};Server=xxx.xxx.xxx.xxx\SQLEXPRESS;Database=JForm;Uid=xxxx;Pwd=xxxx"
strSQL = "UPDATE jURLS " & _
"SET rssFeedURL = 'http://www.xxxx.com/rss/" & rss & "'," & _
"csvURL = 'http://www.xxxx.com/csv/" & csv & "'," & _
"jFormName = '" & forname & "'," & _
"isActive = " & active & " " & _
"WHERE jFormName = '" & forname & "'"
objConn.open
objRS.Open strSQL, objConn, 1,3
'If Not objRS.EOF Then
'iterate through records here
'Else
'no records found
'End If
objRS.close
Set objRS=Nothing
objConn.close
Set objConn=Nothing
It seems to crash on the objConn.open. However, it only gives me a 500 - Internal server error. and not an error thats helpful!
Once i take the database code from the page and leave everything else, it works without the 500 - Internal server error being displayed.
What else can i try in order to get this to work?
you have an extra comma here :
"isActive = " & active & "," & _
change it to:
"isActive = " & active & " " & _
about the connection error, try debugging using the connection.errors collection
On Error Resume Next
objConn.open
for each errobj in objConn.Errors
Response.write errobj.Number & "<br />"
Response.write errobj.Description & "<br />"
next
On Error Goto 0
Try:
response.write(strSQL) <-- this will allow you to look at your current SQL statement and see if it makes sense.
set objRS = objConn.execute(strSQL)

Resources