VBA: Interact with Access from within Outlook - vba

I am trying to create some custom buttons in Outlook that interact with a table contained within an Access database. So far I have my buttons working in Outlook, running code that instantiates a custom data access class which in turn handles opening and closing the connection to the database. So far as I can tell, this much works.
However from this class I cannot even perform a simple select query. Can anyone help me understand why the code below might not work? I always end out with a recordset that has no rows but if I run the same sql using the Access query designer it works fine.
Public Function GetJobID(ByVal xEmailID As String) As Integer
'Returns the JobID associated with a given EmailID from the email link table.
'Returns a fail constant if no link exists.
Dim rs As ADODB.Recordset
Dim sql As String
'Exit if not connected.
'Cast to boolean because VBA doesn't recognise connection state integer as boolean.
If Not CBool(mConn.State) Then
GetJobID = RESULT_FAIL_INTEGER
Exit Function
End If
sql = "SELECT [JobID] FROM [EMAIL_LINK_TABLE] WHERE [EmailID]='xEmailID'"
sql = Replace(sql, "EMAIL_LINK_TABLE", EMAIL_LINK_TABLE)
sql = Replace(sql, "xEmailID", xEmailID)
On Error Resume Next
Set rs = mConn.Execute(sql)
If rs.RecordCount > 0 Then
GetJobID = rs(1).Value
Else
GetJobID = RESULT_FAIL_INTEGER
End If
End Function

I see you've tracked down the issue to .RecordCount returning -1.
This is standard behavior for dynamic cursors, from the docs:
The cursor type of the Recordset object affects whether the number of records can be determined. The RecordCount property will return -1 for a forward-only cursor; the actual count for a static or keyset cursor; and either -1 or the actual count for a dynamic cursor, depending on the data source.
Of course, you can modify your code to use a static cursor, but that will impact performance. Instead, to test if there are records in your recordset, use .EOF (a method returning a boolean to indicate if the recordset is currently at the end of the file). That will save your code from having to load all records, when only loading the first one is required:
Public Function GetJobID(ByVal xEmailID As String) As Integer
'Returns the JobID associated with a given EmailID from the email link table.
'Returns a fail constant if no link exists.
Dim rs As ADODB.Recordset
Dim sql As String
'Exit if not connected.
'Cast to boolean because VBA doesn't recognise connection state integer as boolean.
If Not CBool(mConn.State) Then
GetJobID = RESULT_FAIL_INTEGER
Exit Function
End If
sql = "SELECT [JobID] FROM [EMAIL_LINK_TABLE] WHERE [EmailID]='xEmailID'"
sql = Replace(sql, "EMAIL_LINK_TABLE", EMAIL_LINK_TABLE)
sql = Replace(sql, "xEmailID", xEmailID)
On Error Resume Next
Set rs = mConn.Execute(sql)
If Not rs.EOF Then
GetJobID = rs(0).Value
Else
GetJobID = RESULT_FAIL_INTEGER
End If
End Function

Related

What is causing the delay between recordset.update and the form/report getting the information?

Short version
I'm entering information in a database and fetching it shortly after, but for some reason, when I enter the information, it isn't immediately entered, so that when I try to fetch it, I get old results. Why does this happen? I thought the operations were synchronous.
Long version
I have a split Access database. At the moment the backend is on my own hard drive to speed up testing, eventually this backend will land on a server. Back when it was a combined frontend/backend database and before I had done a major code refactor (tbh, it was quite the clusterfornication before that), and now this is happening in a number of different scenarios, but pretty much every time I enter information and try to fetch it right after that. Why this happens is a mystery to me, since everything I was reading told me there is no multi-threading in VBA and that everything is synchronous if not specified otherwise, and I haven't enabled any asynchronous options.
Two Examples:
I add a record to the database then refresh the form that contains those new records. I'm not going to post the full code (unless it is deemed necessary), since I've modularized the code a lot. But essentially it boils down to this: the user clicks a button which executes this:
Private Sub Anhang_hinzufügen_Click()
If IsNull(Me.Parent.ID) Then
MsgBox "Bitte erst Felder ausfüllen, und anschließend Anhänge hinzufügen", vbInformation
Else
AnhängeAuswählen Me.Parent.Name, Me.Parent.ID
Me.Form.Requery
End If
End Sub
As part of the AnhängeAuswählen method, the method AddRecord is called:
Function AddRecord(TableName As String, fields() As String, values) As Long
Dim Table As DAO.Recordset
Set Table = LUKSVDB.OpenRecordset(TableName)
Table.AddNew
For i = LBound(fields) To UBound(fields)
If TypeName(Table.fields(fields(i)).Value) = "Recordset2" Then
Dim rs2 As DAO.Recordset2
Set rs2 = Table.fields(fields(i)).Value
If IsArray(values(i)) Then
For j = LBound(values(i)) To UBound(values(i))
rs2.AddNew
rs2!Value = values(i)(j)
rs2.Update
Next j
Else
rs2.AddNew
rs2!Value = values(i)
rs2.Update
End If
Else
Table.fields(fields(i)) = values(i)
End If
Next i
AddRecord = Table!ID
Table.Update
Table.Close
End Function
The record is created, that's not the problem. But when it executes Me.Form.Requery, the new record doesn't appear in the form. Only when I execute Me.Form.Requery a fraction of a second later does the record appear.
I add a record to the database using a form, update some information in the recordset with VBA, then requery the subreport with the records. The record appears immediately, but the details I added programmatically only appear when I execute Me.Parent.Requery a couple of seconds later.
The first form is a data entry form, so that as soon as the data is saved, it's blank in order to create a new record. The previous should then appear in the form. The button to create the new record looks like this:
Private Sub Anmerkung_Hinzufügen_Click()
currentID = Me.ID
mSaved = True
If Me.Dirty Then Me.Dirty = False
UpdateRecord "Anmerkungen", currentID, StringArray("Person", "Datum"), Array(User, Now)
Me.Parent.Requery
End Sub
The UpdateRecord is similar to the AddRecord method:
Function UpdateRecord(TableName As String, ByVal ID As Integer, fields() As String, values)
Dim Table As DAO.Recordset
Set Table = SeekPK(TableName, ID, True)
Table.Edit
For i = LBound(fields) To UBound(fields)
If TypeName(Table.fields(fields(i)).Value) = "Recordset2" Then
Dim subtable As DAO.Recordset2
Set subtable = Table.fields(fields(i)).Value
If IsArray(values(i)) Then
On Error Resume Next
Dim t
t = LBound(values(i))
If Developer Then On Error GoTo -1 Else On Error GoTo Fehler
If Err.Number = 0 Then
For j = LBound(values(i)) To UBound(values(i))
subtable.AddNew
subtable!Value = values(i)(j)
subtable.Update
Next j
End If
Else
subtable.AddNew
subtable!Value = values(i)
subtable.Update
End If
Else
Table.fields(fields(i)) = values(i)
End If
Next i
Table.Update
Table.Close
End Function
Does anyone know why this happens, and how I can prevent it? I could do a bit of a workaround with timers on the forms, so that it refreshes the form a couple of seconds later, but that seems like a kludgy workaround to me, especially considering I don't know how long it specifically takes, and the times could change drastically once the backend is on the server.
Additional information, in case it's necessary:
In the code I've posted I've removed some additional code for error handling and performance logging, but it doesn't have any impact on what's happening otherwise.
When the database is opened, a global variable LUKSVDB As DAO.Database is initialized:
Function ConnectDatabase(Backend As Integer)
Select Case Backend
Case 0: DatenOrt = 'redacted, folder in which the production/beta database is located on the server
Case 1: DatenOrt = 'redacted, folder in which I have a personal testing database on the server
Case 2: DatenOrt = 'redacted, folder in which I have the testing database on my own computer
End Select
Set LUKSVDB = OpenDatabase(DatenOrt & "\LUKS-Verwaltung_be.accdb", False, False, ";pwd=PASSWORD")
End Function
For testing purposes, ConnectDatabase is launched with a value of 2. However, if it's a problem on my own SSD, where latency is just about 0, then I can only assume it will be a problem on the server as well, where the latency is definitely not 0.

Optimization for recursive SQL Data reading

I have a function that needs to check the current database values against the live data. Due to the way the database is set up, I need to run the function recursively, and it creates a new local ADO connection each time then deletes it when its finished. it is definitely slowing down my page. Assuming the SQL command is not the problem, is there a better way to obtain the database record (Faster) without establishing a new ADO record set connection each time?
Here is my code/pseudo sample:
Sub recursiveFunction()
~ run data validation ~
Dim newObjRecordSet As Object = SysGlobals.CreateLocalObject()
newObjRecordSet.Open(SQL_COMMAND,objConn, adOpenStatic ,adLockBatchOptimisti)
Do Until newObjRecordSet.eof
If (some condition) Then
write()
Else
recursiveFunction()
End If
newObjRecordSet.MoveNext()
Loop
SysGlobals.DeleteLocalObject(newObjRecordSet)
End Sub
Here are the global functions:
Public Shared Function CreateLocalObject() As Object
Dim localObj As New Object
localObj = CreateObject("ADODB.Recordset")
localObj.CursorLocation = ADORef.ADOVBS.adUseClient
Return localObj
End Function
Public Shared Sub DeleteLocalObject(ByRef localObj As Object)
If localObj.State() Then localObj.Close()
localObj = Nothing
End Sub
Any inputs would be appreciated!

VBA Error in sql function call escapes error trap

When an sql query makes a call to a vba function and that function raises an error, the error handling code fails to handle the error.
See example below. The call to GetId() in the strSql generates an error when the Set rst = db.OpenRecordset(strSql) is executed.
This error is not handled by the On Error GoTo Err_Test error handler!
Public Function GetId() As Long
Err.Raise 11 'Divide by zero error
End Function
Public Function Test() As String
On Error GoTo Err_Test
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSql As String
Set db = CurrentDb()
strSql = "Select * FROM MyTable WHERE MyTable.Id = GetId()"
Set rst = db.OpenRecordset(strSql)
Test = rst!name
Exit_Test:
If Not rst Is Nothing Then
rst.Close
Set rst = Nothing
End If
Set db = Nothing
Exit Function
Err_Test:
MsgBox Error$
Resume Exit_Test
End Function
Why does the error escape the error handler and is there some way to handle it gracefully when the sql makes a call to a vba function that generates an exception?
I know that removing the function call from the sql string as shown below, will enable the error handler to trap the error.
Dim id as Long
id = GetId()
strSql = "Select * FROM MyTable WHERE MyTable.Id = " & id
Is this the only way? If so, should one avoid using function calls in sql query strings to avoid unhandled exceptions?
My take on the observed behavior is this:
When you run "Select * FROM MyTable WHERE MyTable.Id = GetId()", GetId() is evaluated by the query engine, not by Test(), so the error handler in Test() cannot catch the runtime error. It's the same as if you would put the SQL into a query and run that.
When you do "Select * FROM MyTable WHERE MyTable.Id = " & GetId(), GetId() is evaluated by Test().
This would be the "normal" way to run your example (open a recordset in a VBA function), IMO.
But you can also use VBA functions like GetId() in queries. You only need to make sure that either the function is simple enough that it can't trigger a runtime error, or that the function has its own error handler.
If the function is run only once (in the WHERE clause), a MsgBox is acceptable as error handler. If the function is run for every row (i.e. it's in the SELECT clause), this can make for a truly horrible user experience. :p
So make sure that in this case the function returns an error code or NULL or whatever is applicable, like vacip wrote.

Too few parameters in OpenRecordset code

I have two sets of code, that are the same I just change variables to another set that exist and now with the ones I changed I get an error saying "Run-time error '3061': Too few parameters. Expected 6."
This is the changed code:
Dim rec As Recordset
Dim db As Database
Dim X As Variant
Set db = CurrentDb
Set rec = db.OpenRecordset("UnitMoreInfoQ")
Const msgTitle As String = "Open Explorer"
Const cExplorerPath As String = "C:\WINDOWS\EXPLORER.EXE"
Const cExplorerSwitches As String = " /n,/e"
cFilePath = rec("ProjFilePath")
It highlights this line:
Set rec = db.OpenRecordset("UnitMoreInfoQ")
This is the first code:
Dim rec As Recordset
Dim db As Database
Dim X As Variant
Set db = CurrentDb
Set rec = db.OpenRecordset("ProjectMoreInfoQ")
Const msgTitle As String = "Open Explorer"
Const cExplorerPath As String = "C:\WINDOWS\EXPLORER.EXE"
Const cExplorerSwitches As String = " /n,/e"
cFilePath = rec("ProjFilePath")
As you can see, the line has the same amount of parameters:
Set rec = db.OpenRecordset("ProjectMoreInfoQ")
This has gotten me quite confused for awhile because of this. How do I fix this error?
I didn't get the same result as you when testing your db, and I still don't understand the difference. However, maybe we can still get you something which works in spite of my confusion.
The query contains 6 references to form controls, such as [Forms]![WorkOrderDatabaseF]![Text71]. Although you're certain that form is open in Form View when you hit the "too few parameters" error at db.OpenRecordset("UnitMoreInfoQ"), Access doesn't retrieve the values and expects you to supply them.
So revise the code to supply those parameter values.
Dim rec As DAO.Recordset
Dim db As DAO.database
Dim prm As DAO.Parameter
Dim qdf As DAO.QueryDef
Dim X As Variant
Set db = CurrentDb
'Set rec = db.OpenRecordset("UnitMoreInfoQ")
Set qdf = db.QueryDefs("UnitMoreInfoQ")
For Each prm In qdf.Parameters
prm.value = Eval(prm.Name)
Next
Set rec = qdf.OpenRecordset(dbOpenDynaset) ' adjust options as needed
I'm leaving the remainder of this original answer below in case it may be useful for anyone else trying to work through a similar problem. But my best guess is this code change will get you what you want, and it should work if that form is open in Form View.
Run this statement in the Immediate window. (You can use Ctrl+g to open the Immediate window.)
DoCmd.OpenQuery "UnitMoreInfoQ"
When Access opens the query, it will ask you to supply a value for the first parameter it identifies. The name of that parameter is included in the parameter input dialog. It will ask for values for each of the parameters.
Compare those "parameter names" to your query's SQL. Generally something is misspelled.
Using the copy of your db, DoCmd.OpenQuery("UnitMoreInfoQ") asks me for 6 parameters.
Here is what I see in the Immediate window:
? CurrentDb.QueryDefs("UnitMoreInfoQ").Parameters.Count
6
for each prm in CurrentDb.QueryDefs("UnitMoreInfoQ").Parameters : _
? prm.name : next
[Forms]![WorkOrderDatabaseF]![Text71]
[Forms]![WorkOrderDatabaseF]![ClientNameTxt]
[Forms]![WorkOrderDatabaseF]![WorkOrderNumberTxt]
[Forms]![WorkOrderDatabaseF]![TrakwareNumberTxt]
[Forms]![WorkOrderDatabaseF]![WorkOrderCompleteChkBx]
[Forms]![WorkOrderDatabaseF]![WorkOrderDueDateTxt]
Make sure there is a form named WorkOrderDatabaseF open in Form View when you run this code:
Set rec = db.OpenRecordset("UnitMoreInfoQ")
Does the [UnitMoreInfoQ] query execute properly on its own? If you mistype a field in access it will treat that field as a parameter.
ProjectMoreInfoQ and UnitMoreInfoQ are different queries... it sounds like one takes 6 parameters and the other doesn't. Look at the queries in Access and see if either have parameters defined.

Excel drop down values from a SQL Server source

I am trying to get a cell drop-down values in Excel from a SQL Server. I don't want to use the method of putting all the data to another sheet and the use data validation to control the drop down values. That always give my a bunch of empty lines towards the end since I want to make sure I have room for any addition in the DB.
Is there a way to retrieve the drop-down values directly from SQL Server? Using a statement something like:
Select name from employees
Thanks for your help...
Use ADODB to retrieve the values you want, and use the retrieved values to populate a dropdown shape in Excel which you can create dynamically.
In a similar situation, since the source data was basically static, I populated a global array from an ADODB recordset when the application started and used that array when populating the items in the dropdown. Here's a snippet of that code:
Dim InstrumentIDs() As String
Dim InstrumentIDReader As Integer
Dim InstrumentIDCount As Integer
Public PositionRange As String
Public Sub GetInstrumentIDs()
'
'Populate InstrumentIDs array from current contents of Instrument table in EMS database
'
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
Dim loader As Integer, sn As String
InstrumentIDReader = 0
On Error GoTo GetInstrumentError
conn.ConnectionString = "Provider=sqloledb; Data Source=myServer; Initial Catalog=myDatabase; User ID=myUser;Password=myPassword"
conn.Open
sql = "Select Count([SerialNo]) As [Number] From [Instrument]"
rs.Open sql, conn, adOpenStatic
InstrumentIDCount = CInt(rs![Number])
ReDim InstrumentIDs(InstrumentIDCount - 1)
rs.Close
sql = "Select [SerialNo] From [Instrument] Order By [SerialNo]"
rs.Open sql, conn, adOpenForwardOnly
loader = 0
rs.MoveFirst
Do While Not rs.EOF
sn = CStr(rs![SerialNo])
InstrumentIDs(loader) = sn
loader = loader + 1
rs.MoveNext
Loop
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Exit Sub
GetInstrumentError:
MsgBox "Error loading instruments: " & Err.Description
End Sub
You must set a reference to Microsoft ActiveX Data Objects m.n Library (latest version on my computer is 2.8) from Tools > References in VBA editor.
See article
http://www.thespreadsheetguru.com/blog/2014/5/14/vba-for-excels-form-control-combo-boxes for tips on how to manage dropdown boxes in Excel.
You can use the MS Query Wizard in Excel to store a query and use it's data any time.
This this link for details http://www.techrepublic.com/article/use-excels-ms-query-wizard-to-query-access-databases/