How to link Access table to SQL Server with VBA - sql-server

I am trying to create a linked (or imported) table in Access with a SQL Server backend. Basically the business users periodically need a copy of the table [SQL Rulesnew] (yes, with the space, sigh) so we want to give them a little Access 2003 tool that will do the job on demand.
I did try using Docmd.TransferDataBase acTable but no luck
here is the code I am using:
Sub getData()
Dim sConnStr As String
Dim oTable As TableDef
Dim sDestinationTable As String
Dim dbs As Database
Dim tbl As DAO.TableDef
Dim tblLinked As DAO.TableDef
sDestinationTable = "SQL Rulesnew"
Set dbs = CurrentDb
' source table name has a SPACE (rolleyes!)
CurrentDb.CreateTableDef sDestinationTable
' got the below from a Data Link File (UDL)
sConnStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=MYDBNAME;Data Source=MYSERVERNAME"
' the below also failed!
'DoCmd.TransferDatabase acLink, "ODBC Database", "ODBC;Driver={SQL Server};Server=Fos;Database=Hermes_Rep;Trusted_Connection=Yes", acTable, "[Report SQLRulesnew]", "SQLRules" & VBA.Format(Now, "ddmmyyyy")
'If DCount("*", "MSysObjects", "[Name]='[SQL Rulesnew]' AND [Type] In (1, 4, 6)") > 0 Then
If IsTable(sDestinationTable) Then
DoCmd.DeleteObject acTable, sDestinationTable
End If
Set tblLinked = dbs.CreateTableDef(sDestinationTable)
Debug.Print "Linking the " & sDestinationTable
tblLinked.Connect = sConnStr
tblLinked.SourceTableName = sDestinationTable
dbs.TableDefs.Append tblLinked
tblLinked.RefreshLink
End Sub
Function IsTable(sTblName As String) As Boolean
'does table exists and work ?
'note: finding the name in the TableDefs collection is not enough,
' since the backend might be invalid or missing
Dim x
On Error GoTo Coventry
x = DCount("*", sTblName)
IsTable = True
Exit Function
Coventry:
Debug.Print Now, sTblName, Err.Number, Err.Description
IsTable = False
End Function
unfortunately I get an error could not find installable ISAM on the line dbs.TableDefs.Append tblLinked
what should I do?
thanks
Philip

I found the answer through trial and error...
Basically my table names in Access can have a space without using the [square brackets],
so the below command works fine (after deleting any existing object):
DoCmd.TransferDatabase _
acImport, _
"ODBC Database", _
"ODBC;Driver={SQL Server};Server=Fos;Database=Hermes;Trusted_Connection=Yes", _
acTable, _
"sourceTable", _
"targetTable"

Related

Access VBA generated ODBC connection string reverts

I am creating a local MS Access (365) front end application for a SQL Server (Express 2019) DB which is located on a local shared server.
I have a login form that relinks all of the linked tables and views when a user logs in. (This is not primarily for security, so please don't tell me how inadequate this set up is for security - I know.)
Basically, I have a local table in the Access application that lists all the table names that need relinking at login. At login, the current links are deleted, then the code loops through the list of tables and links them according to a connection string that is built in the process, including the UID and the PWD. But when I check on the connection string after login, it doesn't include the login info. My Excel workbook that has a data connection to one of these linked tables cannot connect until I manually edit the string in the Linked Table Manager.
Below is the code for the login process:
Private Sub cmdConnect_Click()
Dim db As Database
Dim tdf As TableDef
Dim rst As Recordset
Dim rst1 As Recordset
Dim strServer As String
Dim strDB As String
Dim strTable As String
Dim strConnect As String
Dim strMsg As String
Dim strPass As String
Dim strPrimary As String
On Error GoTo HandleErr
Set db = CurrentDb
strPass = DLookup("[Password]", "tblUsers", "[User] = '" & Me.txtUser & "'")
If StrComp(Me.txtPwd, strPass, vbBinaryCompare) <> 0 Then
strMsg = "Incorrect Username or password!"
GoTo ExitHere
End If
' Create a recordset to obtain server object names.
Set rst = db.OpenRecordset("tblSQLTables", dbOpenSnapshot)
If rst.EOF Then
strMsg = "There are no tables listed in tblSQLTables."
GoTo ExitHere
End If
'Assign the current user in table
Set rst1 = db.OpenRecordset("tblUsers", dbOpenDynaset, dbSeeChanges)
With rst1
.MoveFirst
Do Until rst1.EOF
.Edit
Select Case !user
Case Me.txtUser
!Current = -1
Case Else
!Current = 0
End Select
.Update
.MoveNext
Loop
End With
strConnect = "ODBC;Driver={ODBC Driver 17 for SQL Server};Trusted_Connection=No;DSN=SQL1;UID=" _
& Me.txtUser & ";PWD=" & Me.txtPwd & ";"
'delete all existing linked tables
Call deleteLinks
' Walk through the recordset and create the links.
Do Until rst.EOF
strServer = rst!SQLServer
strDB = rst!SQLDatabase
strTable = rst!SQLTable
' Create a new TableDef object.
Set tdf = db.CreateTableDef("dbo_" & strTable, 0, "dbo." & strTable, strConnect & "Server=" & strServer & ";Database=" & strDB & ";")
' Set the Connect property to establish the link.
db.TableDefs.Append tdf
Debug.Print tdf.Connect
Set tdf = Nothing
rst.MoveNext
Loop
strMsg = "Tables linked successfully."
rst.Close
Set rst = Nothing
Set tdf = Nothing
Set db = Nothing
DoCmd.Close acForm, Me.name
DoCmd.OpenForm "frmStart"
ExitHere:
MsgBox strMsg, , "Link SQL Tables"
Exit Sub
HandleErr:
Select Case Err
Case Else
strMsg = Err & ": " & Err.Description
Resume ExitHere
End Select
End Sub
Private Sub deleteLinks()
Dim rst As Recordset
Dim db As Database
Dim tdf As TableDef
Set db = CurrentDb
For Each tdf In db.TableDefs
If tdf.name Like "dbo_*" Then
DoCmd.DeleteObject acTable, tdf.name
End If
Next
End Sub
When I look at the immediate window to see the printed tdf.connect it gives me:
ODBC;DRIVER=ODBC Driver 17 for SQL Server;SERVER=RNC1SQL\SQLEXPRESS;UID=****;PWD=*************;Trusted_Connection=No;APP=Microsoft Office;DATABASE=RNCMasterfile;
But when I look at the connection string in the Linked Table Manager, I get the following:
DRIVER=ODBC Driver 17 for SQL Server;SERVER=RNC1SQL\SQLEXPRESS;Trusted_Connection=No;APP=Microsoft Office;DATABASE=RNCMasterfile;
The odd thing is I can access and use the tables in Access, but I have Excel spreadsheets with connections to Access queries based on the linked tables and they don't work if the connection string doesn't contain the login info.
Any ideas to programmatically force the connection string to contain this info?
Try linking your tables using DoCmd.TransferDatabase instead.
DoCmd.TransferDatabase acLink, "ODBC Database", [your_cnn_string], acTable, [source_tbl_name], [linked_table_name], , True
The last option in TranserDatabase is StoreLogin.
I use this in my own apps.
Read about TransferDatabase here.

Using both Excel and Microsoft SQL Server Connection Strings

My task is to add new records from an excel table to a Microsoft SQL Server table, and to do this, I was planning on using ADODB objects; however, my SQL statement is not executing, and I think it has something to do with my connection strings.
In my code, I wrote down the SQL statement that I plan on using in the end, but when I tried:
sql = "SELECT * FROM [Provider=SQLOLEDB;Data Source=hpwfh-ssql01; _
Initial Catalog=HPW DataIntegrated Security=SSPI;Trusted_Connection=Yes].Hubspot_Data"
(a simple select statement) it didn't even work.
Sub update1()
Dim cn, rs As Object, path As String, name As String, sql As String, file As String
path = "T:\Marketing\Data Analytics\Hubspot data for SQL"
name = "Hubspot_Data"
file = path & "\" & name & ".xlsx"
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.connectionstring = "Data Source=" & file & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;Readonly=false;IMEX=0"";"
.Open
End With
sql = "INSERT INTO [Provider=SQLOLEDB;Data Source=hpwfh-ssql01;Initial Catalog=Hubspot_Data;Integrated Security=SSPI;Trusted_Connection=Yes].Hubspot_Data " & _
"SELECT * FROM (SELECT * FROM [Provider=SQLOLEDB;Data Source=hpwfh-ssql01;Initial Catalog=Hubspot_Data;Integrated Security=SSPI;Trusted_Connection=Yes].Hubspot_Data" & _
"EXCEPT SELECT * FROM [hubspot-crm-exports-sql-data-20$])"
Set rs = cn.Execute(sql)
End Sub
Just a side note: the table is named the same thing as the database
For this code, I have gotten three different errors:
The Microsoft Access database engine could not fin the object 'Area' Make
sure the object exists and that you spell its name and the path name
correctly. (And I did not misspell Hubspot_Data)
External table is not in the expected format.
The Microsoft Acess database engine cannot open or write to the file
(My File Path)'\My Documents\Provider=SQLOLEDB.XLSX'. It is already opened
exclusively by another use, or you need permission to view and write its
data.
Clearly the computer is going to the wrong place to retrieve the table it needs, and I have no idea where I went wrong. Thanks for the help.
First of all you need 2 connections - one for SQLSvr and one for Excel.
Then query your source (Excel) and do a separate insert into SQLSvr. You are not going to be able to mix these into one query.
Sub SelectInsert()
Dim cn As Object, rs As Object, sql As String
Dim conSQL As Object, sInsertSQL As String
'---Connecting to the Data Source---
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
.Open
End With
Set conSQL = CreateObject("ADODB.Connection")
With cn
.Provider = "SQLOLEDB"
.ConnectionString = "Server=myServerAddress;Database=myDataBase;Trusted_Connection=True;"
.Open
End With
'---Run the SQL SELECT Query---
sql = "SELECT * FROM [Sheet1$]"
Set rs = cn.Execute(sql)
Do 'the insert. Each rs(n) represents an Excel column.
sInsertSQL = "INSERT INTO table VALUES(" & rs(0) & ";" & rs(1) & ";" & rs(2) & ")"
conSQL.Execute sInsertSQL
rs.MoveNext
Loop Until rs.EOF
'---Clean up---
rs.Close
cn.Close
conSQL.Close
Set cn = Nothing
Set conSQL = Nothing
Set rs = Nothing
End Sub
get properties of your database from "SQL Server Object explorer" and copy the exact same connection string. then copy it to the "appsettings.json" file of your project. It looks like this :
"connectionStrings": {
"ApiDbConnectionString": "Server=(localdb)\\mssqllocaldb;Database=ApiDB;Trusted_Connection=True;"
}
then you need to create an object in your connection string and open a connection to the database using that object, then write your SQL query to the database

runtime error 3704 on a opened object

I am struggling with this situation
I have a query that when i run in MSSQL server management studio it gives me 18 rows, it it stored in a cell. The database is connected to a live server and we would like to create Excel dashboards out of them so it get refreshed with live data and create graph etc....
***** EDIT *****
I tried a very simple query and it works i can get for example
select max(datetime)from table and i do have the latest sync.
The thing is: my query has
1) A Declared table for validation
2) A temporary table "with table as( ) ;" that sorts all data and rank them with some filtering "RowNumber" that is called later in with a where statement that take only some row numbers to avoid repeats
I think that in between the connection must close, can it be?
Normally this code works out but for this server i get:
"runtime error 3704 operation is not allowed when the object is closed"
I've searched the forum and the google with no luck
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim query As String
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
strCon = "Provider=SQLOLEDB.1;" _
& "Password=*******;" _
& "Persist Security Info=True;" _
& "User ID=********;" _
& "Initial Catalog=*******;" _
& "Data Source=***.**.**.**;" _
& "Use Procedure for Prepare=1;" _
& "Auto Translate=True;Packet Size=4096;" _
& "Use Encryption for Data=False;" _
& "Tag with column collation when possible=False"
con.Open (strCon)
rs.ActiveConnection = Con 'modified with suggestion below
strSQLQuery = Worksheets("Query").Range("B2").Value
rs.Open strSQLQuery
For i = 0 To rs.Fields.Count - 1
Sheet2.Cells(1, i + 1) = rs.Fields(i).Name
Next i
Worksheets("Result").Range("A2").CopyFromRecordset rs
rs.Close
Set rs = Nothing
con.Close
Set cn = Nothing
Can a magician help me out? because now im doing it with excel VBA as a demo but i would like to promote it to a VB tool and want to make sure it is not a server related issue.
Thank you in advance
con.Open (strCon)
rs.ActiveConnection = strCon
should be
con.Open strCon
rs.ActiveConnection = con
ie. you should set ActiveConnection to the Connection object you just opened, not to the connection string.

Installable ISAM Error when trying to use DoCmd.TransferDatabase to link a table

I am trying to use DoCmd.TransferDatabase to link a SQL Server Express table to an Access 2013 table. I have no problems with other program code that accesses table data in SQL Server and Access.
The error message that I am getting is: "could not find installable ISAM".
I have had no success in running Microsoft's DoCmd.TransferDatabase sample programs or in finding an answer on the Web to the ISAM problem.
The code is as follows:
Set AccessConn = CreateObject("ADODB.Connection")
With AccessConn
.Provider = "Microsoft.Access.OLEDB.10.0"
'.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Data Provider").Value = "SQLOLEDB"
.Properties("Data Source").Value = TempVars!GlobalServerName
.Properties("User ID").Value = "sa"
.Properties("Password").Value = "xxxxxx"
.Properties("Initial Catalog").Value = TempVars!GlobalDatabaseName
.Open
End With
DoCmd.TransferDatabase acLink, "ODBC Database", _
"[ODBC;DSN={SQL Server Native Client 11.0};Server=XXXS1\SQLExpress;Database=ADatabaseName;Trusted_Connection=yes;]" _
& "DATABASE=D:\DatabaseDirectory\DatabaseTables.accdb", acTable, "Table1", "Table1;"
I had this problem, play with connection string, this worked for me.
"ODBC;Driver={ODBC Driver 17 for SQL Server};SERVER=MyServerName;DATABASE=MyDbName;Trusted_Connection=Yes;"
Private Sub PrintFormPB_Click()
'The purpose of this code is to be able to print Access Reports when the data are stored in
'a SQL Server database. One way to do this is to link all the SQL Tables to all the Access
'tables, but this has multiple disadvantages including the fact that the linker duplicates
'all of the SQL Table data in Access.
'This program only transfers Table data when it is required by Access Reports. The table
'data can then be deleted.
'There are several Report options. You can print the current Form page or all of the pages
'using a Report template. It is also possible to set a variety of printer options.
'This code links a SQL Server Table to an Access Table. The link command creates a new table
'that is named by appending a suffix the Table name. For example, Table allergies is linked
'as Allergies1. It is preferable to link to the original Table name, but the linker
'apparently cannot do this.
'This is part of an Open Source personal "MedicalRecords" program.
Dim strSQL As String
Dim database_path As String
Dim oRpt As Report
Dim AccessConn As New ADODB.Connection
Dim MsgBoxResponse As Integer
Dim ret As Integer
On Error GoTo ErrorHandler
'Setup the Access database connections
Set AccessConn = CreateObject("ADODB.Connection")
With AccessConn
.Provider = "Microsoft.Access.OLEDB.10.0"
'.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Data Source").Value = "D:\MedicalRecordsSQL\MedicalRecordTables.accdb"
.Open
End With
'The following links a SQL Server Table called Allergies to an Access Table called Allergies1.
'The Access table Allergies is then deleted and Allergies1 is renamed to Allergies.
'These are undesirable steps, but no alternative is known at this time.
'Note the formats of the SQL Server statements.
DoCmd.TransferDatabase acLink, "ODBC Database", _
"ODBC;Driver={SQL Server Native Client 11.0};SERVER=RERS1\SQLExpress;UID=sa;PWD=<your Password>;DATABASE=MedicalRecordsSQL;;Table=dbo.Allergies;" _
& "DATABASE=|D:\MedicalRecordsSQL\|MedicalRecordTables.accdb", acTable, "dbo.Allergies", "Allergies"
Set AccessConn = Nothing
DoCmd.DeleteObject acTable, "Allergies"
DoCmd.Rename "Allergies", acTable, "Allergies1"
'Setup Report
DoCmd.OpenReport "Allergies", acViewDesign, Null, Null, acHidden
Set oRpt = Reports(0)
oRpt.UseDefaultPrinter = True
'oRpt.Printer = Application.Printers("printer name")
'Set printer options
With oRpt.Printer
.PaperBin = acPRBNAuto
.PaperSize = acPRPSLetter
.Copies = 1
.PrintQuality = acPRPQMedium
.Orientation = acPRORLandscape
End With
'Print the report
DoCmd.Close acReport, "Allergies", acSaveYes
DoCmd.OpenReport "Allergies", acViewNormal, , "[ID] = " & Me.ID
Set oRpt = Nothing
Exit Sub
ErrorHandler:
MsgBoxReturn = MsgBox("Error Source: Allergies_Form" & vbCrLf & "Error Line: " & Erl & vbCrLf & "Error Number: " & Err.Number & vbCrLf & Err.Description, vbCritical, "")
End Sub

How to create linked tables from MDB to SQL Server

I have an app which is having problems with data-access to an MDB database over a wireless network.
Would a quick solution be to have a local MDB file on all workstations that links all its tables to a SQL Server database?
Would this be a way to avoid having to re-write all data-access code in the app?
Yes, that will do pretty well. We have many customers connected in this way.
However it's not an easy task. Not sure if all the effort required will pay for itself.
And you have some new maintenance and deploying problems.
The steps to follow are this:
1) Migrate your tables to SQLServer
2) Create an ODBC Data Source that will be used to connect to your backend database
3) Connect your tables
4) Rename your connected tables to remove the schema qualifier (eg. "dbo_") so your linked tables have the same name as before.
Now it's time to test all your code.
Hopefully you will not have to rewrite anything.
The real problems lies on client PCs where you need to create an ODBC data source that match your original one. Also if you redistribute your front-end database it's possibile you have to reconnect all the tables from the client PCs.
You need to call a function like this:
Public Function UpdateODBCTables() As Boolean
On Error GoTo Exit_On_Error
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim sDSN As String
Dim sDB As String
Dim sComputer As String
Dim sDesc As String
Dim sApp As String
Dim strConnect As String
sDSN = "YOUR_DSN_NAME"
sDB = "YOUR_DATABASE_NAME"
sComputer = "YOUR_COMPUTER_NAME"
sApp = "YOUR_APP_NAME"
sDesc = "DESCRIPTION_OF_YOUR_APP"
strConnect = "ODBC;DSN=" & sDSN & ";" & _
"DATABASE=" & sDB & ";" & _
"WSID=" & sComputer & ";" & _
"TrustedConnection=Yes;" & _
"Description=" & sDesc & ";" & _
"APP=" & sApp ";"
Set dbs = CurrentDb
' Loop over tabledefs of ODBC type and reconnect
For Each tdf In dbs.TableDefs
If tdf.Connect <> "" And Left(tdf.Connect, 4) = "ODBC" And Left(tdf.Name, 1) <> "~" Then
tdf.Connect = strConnect
tdf.RefreshLink
End If
Next
dbs.TableDefs.Refresh
UpdateODBCTables = True
Exit_On_Return:
Set dbs = Nothing
Exit Function
Exit_On_Error:
MsgBox Err.Description, vbCritical, "YOUR_MESSAGE_TITLE"
Resume Exit_On_Return
End Function

Resources