Update Access 2003 MDB to point to a different SQL Server database - sql-server

Access 2003 / SQL Server - how can I update Access 2003 MDB (Connect property) to point to a different SQL Server database? The new SQL Server database is on the same instance as the old one.

I have several MS Access 2003/SQL Server applications that I manage. All of them dynamically attach to the correct database at startup. Some of them even connect to multiple databases on different servers during the start up sequence. All of them use the same basic vba routine to actually dynamically attach a table to the correct server. This is not my code, I found it by googling around the internet, but I have lost the reference to it now, so apologies in advance to the authors.
Before showing the code, to put it in context, I normally have a form "frmInitApp" with a data source that is a local config table, with a field named "ID". I start the access application from the AutoExec macro which opens this form with a filter of "ID=1". I have other forms to manipulate this config table and change the IDs around, so to switch between production and test I just change which entry has ID=1.
I also have another local table, tableList, with a list of Access tables that I want to connect dynamically to a SQL Server. Most applications have another field in this table for the SQL Server table name (so they don't have to be the same) - some applications have an additional field to specify which database. But the more complex the more other spaghetti you need - I often end up with another table of connection strings to all the separate databases I might connect to etc etc. To keep it simple just have the connection string in a field in the config table that is the datasource to frmInitApp.
We get started with the current event on frmInitApp.
Private Sub Form_Current()
If Me.Filter = "" Then 'If nobody has told us what record to use then use id=1
Me.Filter = "[ID]=1"
configID = 1
Else
configID = CInt(Mid(Me.Filter, 6)) 'We are assuming the load criteria are "[ID]=..."
End If
Me.messages = "Connecting to databases ..."
DoCmd.Hourglass True
Me.stage = "InitialStartup" 'Set the stage which is to be executed during timer phase
Me.TimerInterval = 100 'We set the time to go off to so we can let autoexec finish and let us control focus
End Sub
and then in the timer we can link to the tables via an attach table function with I'll put further down the answer. Note also that we relink pass through queries as well so they point to the new database also. Also note that we start Open a new form a login one fore users as soon as we have attached to the first table. I don't show the conclusion where will probably have to validate username and password against the attached table when its all done, but its trivial to figure out anyway.
Private Sub Form_Timer()
Dim conn As ADODB.Connection
Dim dbRs As ADODB.Recordset
Dim dbOK As Boolean
Dim SQL As String
Dim startedLogon As Boolean
Me.TimerInterval = 0
Select Case Me.stage
Case "InitialStartup"
Set conn = CurrentProject.Connection
startedLogon = False
If CurrentProject.AllForms("frmLogon").IsLoaded Then
'If its already loaded this NOT the first time through, but still need to logon ...
If Form_frmLogon.configID = configID Then
startedLogon = True 'unless its the same config
End If
End If
dbOK = True
Set dbRs = New ADODB.Recordset
dbRs.Open "SELECT localname,servername FROM tableList", conn
While dbOK And Not dbRs.EOF
'PLEASE NOTE - WHILST THEORETICALLY "localname" and "servername" could be different the migration process
'requires that they be the same. Do not consider changing this until after migration is completed
dbOK = AttachTable(dbRs("localname"), "dbo." & dbRs("servername"))
dbRs.MoveNext
If Not startedLogon And dbOK Then
DoCmd.Close acForm, "frmLogon" '#554 Just in case its alread open - we need to pick up new params
DoCmd.OpenForm "frmLogon", , , , , , Nz(Me.lastUserId, "") & ":" & configID
Form_frmLogon.SetFocus '#748 Give it focus
startedLogon = True
End If
Wend
dbRs.Close
If dbOK Then
Me.messages = "Relinking Common Queries ..."
DoEvents
Dim qd As DAO.QueryDef, cs As String
cs = getStrConnDAO 'get the DAO connection string
For Each qd In CurrentDb.QueryDefs
If Len(qd.Connect & vbNullString) > 0 Then
qd.Connect = cs
End If
Next
End If
Me.messages = "Awaiting User Log On"
DoCmd.Hourglass False
DoEvents
... the rest just managing logon
End Sub
The attached table function
'//Name : AttachTable
'//Purpose : Create a linked table to SQL Server without using a DSN
'//Parameters
'// stLocalTableName: Name of the table that you are creating in the current database
'// stRemoteTableName: Name of the table that you are linking to on the SQL Server database
Private Function AttachTable(stLocalTableName As String, stRemoteTableName As String)
Dim td As TableDef
Dim stConnect As String
Me.messages = "Connecting to Database Table " & Me.mainDatabase & "." & stRemoteTableName
DoEvents
On Error Resume Next
CurrentDb.TableDefs.Delete stLocalTableName
If Err.Number <> 0 Then
If Err.Number <> 3265 Then GoTo AttachTable_Err 'v4.0.44 - allow delete errors
Err.Clear
End If
On Error GoTo AttachTable_Err
Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, getStrConnDAO(configID))
CurrentDb.TableDefs.Append td
DoEvents
AttachTable = True
Exit Function
AttachTable_Err:
AttachTable = False
errMsg = "AttachTable encountered an unexpected error: " & Err.description & " on table " & stRemoteTableName & " in database " & Me.mainDatabase
End Function
You will need to getConStrDAO function
Private ADOconnStr As String
Private DAOconnStr As String
Public Function getStrConn(Optional configID As Long = 0) As String
'create a connection string for use when running stored procedures
'this uses the saved value if possible, but global variables are reset if an error occurs
If ADOconnStr = "" Then
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim account As String
Dim revealedPassword As String
Dim s As String, i As Integer, x As String
Set conn = CurrentProject.Connection
If configID = 0 Then configID = Nz(Form_frmLogon.configID, 0)
Set rs = conn.Execute("SELECT * FROM localConfig WHERE id =" & configID)
If Not rs.EOF Then
ADOconnStr = "Provider=Microsoft.Access.OLEDB.10.0;Data Provider=SQLOLEDB;SERVER=" 'this provider is needed to allow use of SP as form.recordset
ADOconnStr = ADOconnStr & rs("ServerName") & ";DATABASE=" & rs("DatabaseName") & ";UID="
ADOconnStr = ADOconnStr & rs("dbUser") & ";PWD=" & EncryptDecrypt(Nz(rs("dbPassword"), ""))
End If
rs.Close
Set rs = Nothing
Set conn = Nothing
End If
getStrConn = ADOconnStr
End Function
Public Sub resetConnection()
ADOconnStr = ""
DAOconnStr = ""
End Sub
Function getStrConnDAO(Optional configID As Long = 0) As String
If DAOconnStr = "" Then
Dim a As New ADODB.Connection
a.Open getStrConn(configID)
DAOconnStr = "ODBC;driver=SQL Server;" & a.Properties("Extended Properties") & ";"
Set a = Nothing
End If
getStrConnDAO = DAOconnStr
End Function
And finally a simple encryption of database password to make it not obvious to casual eyes - something again copied from the internet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments: Performs XOr encryption/decryption on string data. Passing a
''' string through the procedure once encrypts it, passing it
''' through a second time decrypts it.
'''
''' Arguments: szData [in|out] A string containing the data to
''' encrypt or decrypt.
'''
''' Date Developer Action
''' --------------------------------------------------------------------------
''' 05/18/05 Rob Bovey Created
'''
Public Function EncryptDecrypt(szData As String) As String
Const lKEY_VALUE As Long = 215
Dim bytData() As Byte
Dim lCount As Long
bytData = szData
For lCount = LBound(bytData) To UBound(bytData)
bytData(lCount) = bytData(lCount) Xor lKEY_VALUE
Next lCount
EncryptDecrypt = bytData
End Function

Related

Loop to insert multiple values into SQL Server

I am trying to insert a lot of values into SQL Server in one SQL insert statement. So for example..
Insert Into someDataBase
Values(value1, value2, value3,..., value120, value121)
All these values will be in the correct order on a sheet in Excel. I already created a loop to go through all the 121 values but I can't think of a loop for the inserting the values without writing each value individually.
Can anyone help me out?
My code looks like this:
Sub AddRows()
' In VBE you need to go Tools References and check Microsoft Active X Data Objects 2.x library
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim comm As ADODB.Command
Set comm = New ADODB.Command
Dim param As ADODB.Parameter
Dim getType As String
SQLStr = "Insert Into [DB] Values("
For i = 1 To 121
'Get type
getType = CellType(i, Cells(2, i))
SQLStr = SQLStr & "?,"
Set param = New ADODB.Parameter
param.Name = "Param" & i
Set param = comm.CreateParameter("param" & i, getType, adParamInput, 1000)
param.Attributes = adParamNullable
Debug.Print (param.Type)
comm.Parameters.Append param
Next i
SQLStr = Left(SQLStr, Len(SQLStr) - 1) & ");"
Set Cn = New ADODB.Connection
Cn.CommandTimeout = 0
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
comm.ActiveConnection = Cn
comm.CommandText = SQLStr
comm.CommandType = adCmdText
Dim test As String
lastrow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
'For x = 2 To lastrow
For i = 1 To 121
Debug.Print (Cells(2, i).Value)
comm.Parameters.Item("Param" & i).Value = Cells(2, i).Value
Next
comm.Execute
'Next x
Cn.Close
Set Cn = Nothing
End Sub
This is a portion of my CellType Function:
Private Function CellType(Num) As MultipleValues
Application.Volatile
CellType.CellNum = 50
Select Case True
Case Num = 1
CellType.CellType = adInteger
Case Num = 2
CellType.CellType = adInteger
Case Num = 3
CellType.CellType = adVarWChar
CellType.CellNum = 255
Case Num = 4
CellType.CellType = adCurrency
Case Num = 5
CellType.CellType = adVarWChar
CellType.CellNum = 255
The values for the first 5 values are: 0, null, 6071/1, 44.5, Biltmore Fleur De Lis Collection Authentic Wrought Iron
It breaks on the second value which is a null but should be an integer.
I would generally agree that using an SSIS package would be the best way to approach this, but if you want to do it through code, it's not difficult with a parameterized query in ADODB:
Use the ? placeholder for parameters when you're building your INSERT statement, and add parameters to an ADODB.Command object:
Dim comm As ADODB.Command
Set comm = New ADODB.Command
Dim param As ADODB.Parameter
SQLStr = "Insert Into [db] Values("
For i = 1 To 121
SQLStr = SQLStr & "?,"
Set param = New ADODB.Parameter
param.Name = "Param" & i
comm.Parameters.Append param
Next i
SQLStr = Left(SQLStr, Len(SQLStr) - 1) & ");"
When you're done, you'll have a matched set of parameters and placeholders.
Then open your connection (or do it before this, it really doesn't make much difference) and set up the command:
comm.ActiveConnection = Cn
comm.CommandText = SQLStr
comm.CommandType = adCmdText
Finally, loop through your rows for each record, loop through the values and assign them to parameters, and execute for each row:
lastrow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
For x = 2 To lastrow
For i = 1 To 121
comm.Parameters.Item("Param" & i).Value = Cells(x, i).Value
Next
comm.Execute
Next x
Note that ADODB Commands are optimized to be looped over - the backend treats this more like a batch insert, so there isn't really much point in trying to build a gigantic insert will all the records in it at once.
Don't know if the excel spreadsheet has special formatting, but if its in a CSV format, you can use SQL Server Import and Export Wizard to do this. Here's how:
In SQL Server Management Studio, login to your database server.
Right click the database you want to import data into and select Task -> Import Data
Import Data Image
On the Choose Data Source screen, choose Microsoft Excel from the Data Source drop down. Enter the file path to the excel spreadsheet in Excel file path. Select the appropriate Excel version in Excel version. If the first row in the spreadsheet contains the database column names, check the First row has column names. If it's just data, uncheck it.
Choose Data Source Image
Click Next and choose Microsoft OLE DB Provider for SQL Server in the Destination drop down. Select your sql server name in Server name drop down. Choose Authentication option. Click Refresh, then choose the database you want to insert the Excel data into.
On the Specify Table Copy or Query window, select Copy data from one or more table or views. Click Next.
Select the check box next to Sheet1$ in the Source column. Click in the Destination column and select the table you want to import the Excel data into. Clicking the Preview button will show the query and how the data will look in the new table. Click Next.
The mapping should be good on the Review Data Type Mapping page. This window allows you to setup options on what SQL should do in regards to converting. Defaults should be fine. Click Next.
Click Next. The import should run immediately.
Review the summary page and click Finish.
The import will perform several operations. Green check marks indicate that the operation was successful. Read circles with X's indicate failure. If you get a failure, post an image of it here with your data and the hyperlinked message from the Message column.
If you want, you can check out the bulk insert command as well on MSDN. I don't have enough rep to post more images. I'll finish it later when I have enough.

MS Access show current users not showing username

I'm currently using a piece of code to display who is logged into our Access Database. It's a split database, with a backend and multiple frontends. I am currently using this code:
Private Sub btnShowUsers_Click()
'The User List Schema information requires this magic number. For anyone
'who may be interested, this number is called a GUID or Globally Unique
'Identifier - sorry for digressing
Const conUsers = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
Dim cnn As ADODB.Connection, fld As ADODB.Field, strUser As String
Dim rst As ADODB.Recordset, intUser As Integer, varValue As Variant
Set cnn = CurrentProject.Connection
Set rst = cnn.OpenSchema(Schema:=adSchemaProviderSpecific, SchemaID:=conUsers)
'Set List Box Heading
strUser = "Computer;UserName;Connected?;Suspect?"
Debug.Print rst.GetString
With rst 'fills Recordset (rst) with User List data
Do Until .EOF
intUser = intUser + 1
For Each fld In .Fields
varValue = fld.Value
'Some of the return values are Null-Terminated Strings, if
'so strip them off
If InStr(varValue, vbNullChar) > 0 Then
varValue = Left(varValue, InStr(varValue, vbNullChar) - 1)
End If
strUser = strUser & ";" & varValue
Next
.MoveNext
Loop
End With
Me!txtTotalNumOfUsers = intUser 'Total # of Users
'Set up List Box Parameters
Me!lstUsers.ColumnCount = 4
Me!lstUsers.RowSourceType = "Value List"
Me!lstUsers.ColumnHeads = False
lstUsers.RowSource = strUser 'populate the List Box
'Routine cleanup chores
Set fld = Nothing
Set rst = Nothing
Set cnn = Nothing
End Sub
This works, and it returns the laptop numbers of the users currently using the system, but in the 'Username' column it just says 'ADMIN'. Is there any way to get this to show their Windows username, ie their VBA.Environ("USERNAME")?
No, this is not possible.
This column shows the Access username, same as the Application.CurrentUser() method.
Unless you set up user-level security, add all users to the workgroup file, and start Access with a command-line parameter like
/User %username%
, the user name will always be "Admin".

Access VBA connection to test existence of SQL Server

I have an Access application that needs to connect to one of several possible SQL Servers (i.e., connect linked tables) and I have a list of those possible SQL Server instance names. When the application launches, it needs to go see which of the possible servers is available. Considering the sluggishness of solutions like using SQLBrowseConnect or NetServerEnum, I'm wondering if there is a clean and fast way to 'ping' for a SQL Server based on its name.
We use a pass-through query, VerifyConnection, which just opens a small table.
The test alters the connection and checks if it can read the table:
Public Function IsSqlServer( _
ByVal TestNewConnection As Boolean, _
Optional ByVal Hostname As String, _
Optional ByVal Database As String, _
Optional ByVal Username As String, _
Optional ByVal Password As String, _
Optional ByRef ErrNumber As Long) _
As Boolean
Const cstrQuery As String = "VerifyConnection"
Dim dbs As DAO.Database
Dim qdp As DAO.QueryDef
Dim rst As DAO.Recordset
Dim booConnected As Boolean
Dim strConnect As String
Dim strConnectOld As String
Dim booCheck As Boolean
Set dbs = CurrentDb
Set qdp = dbs.QueryDefs(cstrQuery)
If Hostname & Database & Username & Password = "" Then
If TestNewConnection = False Then
' Verify current connection.
booCheck = True
Else
' Fail. No check needed.
' A new connection cannot be checked with empty parameters.
End If
Else
strConnectOld = qdp.Connect
strConnect = ConnectionString(Hostname, Database, Username, Password)
If strConnect <> strConnectOld Then
If TestNewConnection = False Then
' Fail. No check needed.
' Tables are currently connected to another database.
Else
' Check a new connection.
qdp.Connect = strConnect
booCheck = True
End If
Else
' Check the current connection.
strConnectOld = ""
booCheck = True
End If
End If
On Error GoTo Err_IsSqlServer
' Perform check of a new connection or verify the current connection.
If booCheck = True Then
Set rst = qdp.OpenRecordset()
' Tried to connect ...
If ErrNumber = 0 Then
If Not (rst.EOF Or rst.BOF) Then
' Success.
booConnected = True
End If
rst.Close
End If
If strConnectOld <> "" Then
' Restore old connection parameters.
qdp.Connect = strConnectOld
End If
End If
Set rst = Nothing
Set qdp = Nothing
Set dbs = Nothing
IsSqlServer = booConnected
Exit_IsSqlServer:
Exit Function
Err_IsSqlServer:
' Return error.
ErrNumber = Err.Number
ErrorMox "Tilslutning af database"
' Resume to be able to restore qdp.Connect to strConnectOld.
Resume Next
End Function
This way you will check the complete route all the way to a single table.

while rs edit update not working as expected

I have put together a procedure to cycle through a table containing paths to text files and import them into the database.
Reason for procedure:
The reason for this is I am building a back end to many reporting databases that rely on nightly updated text files. Recently they changed the server name and file names for these files, so I'm trying to build something more reliable so I don't have to run through the link table wizard making sure all the data types are exactly the same as before.
Issue:
The issue I have is the With .edit .update isn't acting like I thought it should and updating the field 'Updated' in the table to today's date.
Here is the code. I'm still new to programming, so apologies.
Private Sub ImportAll()
' Loops through table containing paths to text files on network and imports
Dim ID As Integer
Dim netPath As String
Dim netDir As String
Dim netFile As String
Dim localTable As String
Dim activeTable As Boolean
Dim updatedTable As Date
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Tables")
Do Until rst.EOF
ID = rst.Fields("Table ID").Value
netDir = rst.Fields("Network Location").Value
netFile = rst.Fields("File Name").Value
localTable = rst.Fields("Local Table Name").Value
activeTable = rst.Fields("Active").Value
updatedTable = rst.Fields("Updated").Value
If activeTable = True And updatedTable <> Date Then
If ifTableExists(localTable) Then
On Error GoTo ImportData_Err
CurrentDb.Execute "DELETE * FROM " & localTable, dbFailOnError
netPath = netDir & netFile
DoCmd.TransferText acImportDelim, , localTable, netPath, True, ""
rst.Edit
updatedTable = Date
rst.Update
Else
netPath = netDir & netFile
DoCmd.TransferText acImportDelim, , localTable, netPath, True, ""
With rs
.Edit
.Fields("Updated") = Date
.Update
End With
End If
End If
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
ImportData_Exit:
Exit Sub
ImportData_Err:
MsgBox Error$
Resume ImportData_Exit
End Sub
Thank you.
Where you have
With rs
You meant
With rst
Mistakes such as this can be caught by turning on Option Explicit. Option Explicit means that all variables must be declared.
See here: How do I force VBA/Access to require variables to be defined?

Transactions using DAO and Sql Server linked tables

I'm migrating a clasic Access application to Sql Server, i.e., DAO+Linked tables.
I've found a fustrating behavior: when i make changes using recordsets over linked tables, Access use more than one connection. More than one connection means more than one transaction at time on server side. These transactions are independent. Not nested.
Standard MS-Access behavior using linked tables to a .mdb files is different. There is only one transaction at time. Every db change is visible by any code that runs in the same DAO.Workspace before executing commit.
Rules has been changed and existing DAO code using client side transactions will fail.
If i add or update a record using a recordset open as dbOpenDynaset, any code trying to read them after will fail: Doesn't find new records and see existing records in the original state. Why? Because operations are maded in multiple and independent transactions
Executing the sample provided code, sql profiler will show you that different operations are made with different transactions ID's.
I've tested this using ADO and everything works well. But there are thousands code lines.
Is there any solution other than rewrite code using ADO?
Can i modify standard Access behaviour? ( use read uncommitted isolation level, instruct to not open new connections, ...)
Below code reproduces the problem. It's very simple:
1.- Open a recordset on existing record
2.- Add new record
3.- Try to read recently added record
If i use dbOpenDynaset in (1), i'll not see new record in (3).
I'm using Acc-2010, .accdb format files and Sql Server 2008 R2
Thanks.
Private Sub test0()
Dim bResult As Boolean
Dim bUseTrans As Boolean 'New record added in transaction
Dim rsExist As DAO.Recordset2 'Dummy recordset
Dim tRecordsetExist As DAO.RecordsetTypeEnum 'Dummy recordset type:
' with dbOpenDynaset fail.
' Any other works fine
Dim rs2Add As DAO.Recordset
Dim rs2Read As DAO.Recordset 'Used to read recently added record
Dim tRecordset2Read As DAO.RecordsetTypeEnum 'Recordset type used to read new record. Doesn't affect
Dim bTranInitiated As Boolean 'Track if we are in transaction
Dim lngExistingNumber As Long
Dim lngNewNumber As Long
Dim lngNewID As Long
Dim strSQL As String
On Error GoTo HandleErr
'Invoices table definition in SS. Table is linked as [dbo_Invoices]:
' CREATE TABLE [dbo].[Invoices](
' [IdInvoice] [int] IDENTITY(1,1) NOT NULL,
' [InvoiceNumber] [int] NOT NULL,
' [InvoiceDescription] [varchar](50) NOT NULL,
' CONSTRAINT [PK_Invoices] PRIMARY KEY CLUSTERED
' (
' [IdInvoice] Asc
' )WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON) ON [PRIMARY]
' ) ON [PRIMARY]
Set wks = DBEngine.Workspaces(0)
Set dbs = wks.Databases(0)
bUseTrans = True 'Without transaction everything works well
tRecordsetExist = dbOpenDynaset 'Dummy recordset type:
' dbOpenDynaset makes fail.
' Any other works fine
tRecordset2Read = dbOpenForwardOnly 'Does not affect
lngExistingNumber = 12001
lngNewNumber = -lngExistingNumber
'Clean previous runs of the test and make sure that referenced invoice exists.
dbs.Execute "Delete from dbo_Invoices Where InvoiceNumber = " & lngNewNumber, dbFailOnError Or dbSeeChanges
On Error Resume Next
strSQL = "Insert Into dbo_Invoices (InvoiceNumber, InvoiceDescription) " & _
" Values (" & lngExistingNumber & ", 'Original invoice' )"
dbs.Execute strSQL, dbFailOnError Or dbSeeChanges
On Error GoTo HandleErr
If bUseTrans Then
wks.BeginTrans
bTranInitiated = True
End If
strSQL = "Select IdInvoice, InvoiceNumber from dbo_Invoices " & _
" Where InvoiceNumber = " & lngExistingNumber
If tRecordsetExist = dbOpenDynaset Then
Set rsExist = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
Else
Set rsExist = dbs.OpenRecordset(strSQL, tRecordsetExist)
End If
If rsExist.BOF And rsExist.EOF Then
Err.Raise vbObjectError, , "Original invoice " & lngExistingNumber & " not found"
End If
Set rs2Add = dbs.OpenRecordset("Select * from dbo_Invoices", dbOpenDynaset, dbAppendOnly Or dbSeeChanges)
rs2Add.AddNew
rs2Add!InvoiceNumber = lngNewNumber
rs2Add!InvoiceDescription = "Invoice anulation, ref " & lngExistingNumber
rs2Add.Update
'After executing .Update rs2Add goes to .EOF. This action reposition the recordset on the new record
rs2Add.Move 0, rs2Add.LastModified
lngNewID = rs2Add!IdInvoice
Debug.Print "New record added: IdInvoice = " & rs2Add!IdInvoice & ", InvoiceNumber = " & rs2Add!InvoiceNumber
'Try to read the new record
strSQL = "Select * from dbo_Invoices Where IdInvoice = " & lngNewID
If tRecordset2Read = dbOpenDynaset Then
Set rs2Read = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
Else
Set rs2Read = dbs.OpenRecordset(strSQL, tRecordset2Read)
End If
If (rs2Read.BOF And rs2Read.EOF) Then
Err.Raise vbObjectError, , "rs2Read: Not found using IdInvoice = " & lngNewID
End If
Debug.Print "New record found with IdInvoice = " & rs2Read!IdInvoice
rs2Read.Close
bResult = True
ExitHere:
If Not wks Is Nothing Then
If bTranInitiated Then
If bResult Then
wks.CommitTrans
Else
wks.Rollback
End If
bTranInitiated = False
End If
End If
On Error Resume Next
If Not rs2Add Is Nothing Then
rs2Add.Close
Set rs2Add = Nothing
End If
If Not rs2Read Is Nothing Then
rs2Read.Close
Set rs2Read = Nothing
End If
Exit Sub
HandleErr:
Dim e As Object
If Err.Description Like "ODBC*" Then
For Each e In DBEngine.Errors
MsgBox e.Description, vbCritical
Next
Else
MsgBox Err.Description, vbCritical
End If
bResult = False
Resume ExitHere
Resume
End Sub
Unfortunately, Microsoft states the following about Workspace.IsolateODBCTrans Property:
http://msdn.microsoft.com/en-us/library/office/bb208483(v=office.12).aspx
Some ODBC servers, such as Microsoft SQL Server, don't allow simultaneous transactions on a single connection. If you need to have more than one transaction at a time pending against such a database, set the IsolateODBCTrans property to True on each Workspace as soon as you open it. This forces a separate ODBC connection for each Workspace.
Not sure if this will help you deciding what to do.
You may continue to use dao for those tables that remain in the mdb. However for the sqlserver tables (linkled tables) like this:
Global objConn As New ADODB.Connection
and in the routine:
Dim rst As ADODB.Recordset
DoCmd.SetWarnings False
If objConn.State <> adStateOpen Then
MsgBox ("Connection to SQL server has not been made. Please exit and resolve problem.")
Exit Sub
End If
Set rst = New ADODB.Recordset
Dim stdocname As String
rst.Open "tblbilling", objConn, adOpenDynamic, adLockPessimistic
etc etc etc.....

Resources