Reserved Error when capturing changes on Access 2013 Form - vba

I'm using the code within the following link within an Access 2013 form to capture changes made to records: https://www.techrepublic.com/article/a-simple-solution-for-tracking-changes-to-access-data/
I have the ErrorHandler commented out and am getting a "<Reserved Error>" within the line: If (.Value <> .OldValue or ((Not IsNull .... This causes the statement not to read True and is skipped over.
I'm calling this Sub in BeforeUpdate trigger on the Review Form:
Sub ReviewFormAuditTrail(frm As Form, recordid As Control)
'Track changes to data.
'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSQL As String
Dim ChangeReason As Variant
'On Error GoTo ErrHandler
'Get changed values.
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
If .ControlType = acComboBox Then
'Changed this is allow for both null to value and value to null
If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
ChangeReason = Forms![Review Form]!ChangeReason
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "xAudit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue, ChangeReason) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & "," _
& cDQ & ChangeReason & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
ElseIf .ControlType = acTextBox Then
'Changed this is allow for both null to value and value to null
If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
ChangeReason = Forms![Review Form]!ChangeReason
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "xAudit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue, ChangeReason) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & "," _
& cDQ & ChangeReason & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End If
End With
Next
Set ctl = Nothing
Exit Sub
'Added to ignore the error produced from processing in joined tables
ErrHandler:
'If Err.Number = 3251 Then
' Response = acDataErrContinue
'Else
' MsgBox Err.Description & vbNewLine _
' & Err.Number, vbOKOnly, "Error"
'End If
End Sub

Consider the industry standard when using SQL at application layer (i.e., VBA) by using a parameterized query with MS Access' QueryDef.Parameters which I assume is the crux of your issue.
With this approach you divorce SQL from VBA for better readability and maintainability without need to concatenate or enclose with quotes. Your above link runs a VBA concatenated SQL string and curiously does not combine the two repetitive If blocks:
SQL (save as you would any MS Access query)
PARAMETERS paramEditDate Date, paramUser Text(255), paramRecordID Long,
paramSourceTable Text(255), paramSourceField Text(255),
paramBeforeValue Text(255), paramAfterValue Text(255), paramChangeReason Text(255);
INSERT INTO xAudit (EditDate, [User], RecordID, SourceTable
SourceField, BeforeValue, AfterValue, ChangeReason)
VALUES (paramEditDate, paramUser, paramRecordID, paramSourceTable,
paramSourceField, paramBeforeValue, paramAfterValue, paramChangeReason);
VBA (pass form name as argument and use Forms() collection)
Sub ReviewFormAuditTrail(frm_name As String, recordid As Control)
On Error GoTo ErrHandler
'Track changes to data.
'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant, varAfter As Variant, ChangeReason As Variant
Dim strControlName As String, strSQL As String
Dim qdef As QueryDef
'Get changed values.
For Each ctl In Forms(frm_name).Controls
With ctl
'Avoid labels and other controls with Value property.
If .ControlType = acComboBox Or .ControlType = acTextBox Then
'Changed this is allow for both null to value and value to null
If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) _
Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
ChangeReason = Forms![Review Form]!ChangeReason
' RETRIEVE SAVED QUERY
Set qdef = CurrentDb.QueryDefs("mySavedQuery")
' BIND PARAMS
qdef!paramEditDate = Now()
qdef!paramUser = Environ("username")
qdef!paramRecordID = recordid.Value
qdef!paramSourceTable = Forms(frm_name).RecordSource
qdef!paramSourceField = strControlName
qdef!paramBeforeValue = varBefore
qdef!paramAfterValue = varAfter
qdef!paramChangeReason = ChangeReason
' EXECUTE QUERY
qdef.Execute dbFailOnError
End If
End if
End With
Next ctl
ExitHandler:
Set ctl = Nothing: Set qdef = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description & vbNewLine & Err.Number, vbOKOnly, "Runtime Error"
Resume ExitHandler
End Sub

Related

Copying the text from the combo box instead of the primary key in my Access audit trail

I have been working on this for a week and have not found a way still... within my access file, I have the following code that creates an audit trail for changes made to a form, would you be able to help me modify the code below so that when the change is made from a Combo box or a option group, the audit record shows the text value inside the combo box/option group instead of the primary key associated with that text value?
Thank you so much in advance.
K
Option Compare Database
Const cDQ As String = """"
Sub AuditTrail(frm As Form, recordid As Control)
'Track changes to data.
'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSQL As String
On Error GoTo ErrHandler
'Get changed values.
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup
If IsNull(.Value) And Not IsNull(.OldValue) Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
ElseIf IsNull(.OldValue) And Not IsNull(.Value) Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
ElseIf .Value <> .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End Select
End With
Next
Set ctl = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description & vbNewLine _
& Err.Number, vbOKOnly, "Error"
End Sub
For combobox, include text field as column of combobox and reference that column by its index. Combobox RowSource like SELECT ID, fieldname FROM table;. Set ColumnCount: 2; ColumnWidths: 0";2" (0 will hide column). Index begins with 0 so if text field is second column, its index is 1. Me.combobox.Column(1).
Assuming option group uses radio buttons, each radio button has a numeric OptionValue. The option group frame adopts the selected radio button OptionValue as Value. Convert these numbers to associated descriptive text. Either do DLookup() to a table or hard-code conversion. Example with 3 radio buttons with OptionValue 1, 2, 3:
Choose(Me.optGender, "Female", "Male", "Not Given")

Custom Audit Trail in Access to capture login details

I have a login screen that I built in Access, I need the UserName (which is a column in table "Employee"), to be stored in "Audit" Table which I have built to store changes that take place in the DB.
When I login from the custom login screen it should have the username captured in (tempvars maybe) and it should remain available till the user closes the program, i.e. during the session (logged in as lets say "user_x") and I also want this UserName to be captured in Audit table.
I got a code from the internet to capture the changes that take place in the DB but it uses the Access login utility. I want to change it to capture login details from my custom login table once a user logs in.
Const cDQ As String = """"
Sub AuditTrail(frm As Form, recordid As Control)
'Track changes to data.
'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSQL As String
On Error GoTo ErrHandler
'Get changed values.
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
If .ControlType = acTextBox Then
If .Value .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End If
End With
Next
Set ctl = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description & vbNewLine _
& Err.Number, vbOKOnly, "Error"
End Sub
Username to be captured in Audit Table once a user logs in using the login screen.
What should I use in place of
& cDQ & Environ("username") & cDQ & ", " _
to capture my userName coming from a successful login action from the custom Login Screen that I built.
If you want to use the userName the user enters in your login form, just replace the Environ("username") with the value of the textbox from your login form. Lets say the textbox in your login form is called txtUserName then just replace your code with this:
= & cDQ & Me!txtUserName.Value & cDQ & ", "
The Me! refers to your form where your code gets executed (your login form).

Syntax error (missing operator) in query expression when running Audit Trail module in MS Access

I am trying to run an Audit Trail module on an Invoice form to keep track of changes. The same module works fine with several of my other forms, and my Invoice form doesn't cause any errors when I don't have the Audit Trail running. I am no expert and am not sure what to do to solve this! Here is the SQL for the form's record source, which is what causes the error:
SELECT tblInvoice.*, tblAssignment.RateOut, tblTaskOrder.TaskOrderID, tblTaskOrder.TaskOrderName, tblPeople.PeopleID, tblPeople.[Firstname] & " " & [Lastname] AS FullName, tblVendor.VendorName
FROM (((tblInvoice INNER JOIN tblAssignment ON tblInvoice.AssignmentID = tblAssignment.AssignmentID) INNER JOIN tblTaskOrder ON tblAssignment.TaskOrderID = tblTaskOrder.TaskOrderID) INNER JOIN tblPeople ON tblAssignment.PeopleID = tblPeople.PeopleID) INNER JOIN tblVendor ON tblPeople.Vendor = tblVendor.VendorID;
And here is the Audit Trail module code:
Option Compare Database
Option Explicit
Const cDQ As String = """"
Sub AuditTrail(frm As Form, recordid As Control)
'Track changes to data.
'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSQL As String
On Error GoTo ErrHandler
'Get changed values.
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
If .ControlType = acTextBox Then
If .Value <> .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "tblAudit (EditDate, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End If
End With
Next
Set ctl = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description & vbNewLine _
& Err.Number, vbOKOnly, "Error"
End Sub
Any ideas for me? TIA!!
Your Audit Trail code has naive type conversion. Just tacking " characters on either end of the RecordSource string won't work all the time.
Current (wrong) quoted RecordSource value:
"SELECT ... , tblPeople.[Firstname] & " " & [Lastname] AS FullName, ... "
The problem is the " " in the middle turns it into two strings!
Correct value for Access SQL:
"SELECT ... , tblPeople.[Firstname] & "" "" & [Lastname] AS FullName, ... "
Now that the quotes are quoted, the insert will work fine.
To fix your code, do something like:
...
& cDQ & Replace(frm.RecordSource, cDQ, cDQ & cDQ) & cDQ & ", " _
...
This is sloppy code, but you get the idea. You should do this for all string values you are inserting into the Audit Trail.

CRUD Error with ADO

I am in the process of developing an Access 2016 database that has local tables. It will be migrated to SQL Server in future so I am using ADO for data processing.
While testing earlier, my error processing procedure failed to perform a log insert immediately after an error was trapped in the following test CRUD procedure.
Public Function updateTransportRate(lngOrigin As Long, lngDestination As Long, dblRate As Double) As Boolean
' check if global error handling is enabled ->
If glbErrorHandling Then On Error GoTo Error_Handler
' declarations ->
Dim strSQL As String
Dim strGUID As String
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
Dim p_lRowsUpdated as Integer
strSQL = "UPDATE tbl_transport " & _
"SET rate=" & dblRate & ", modify_dtm=Now(), modify_user ='" & Application.CurrentUser & "' " & _
"WHERE origin=" & lngOrigin & " AND destination=" & lngDestination & ""
With cnn
.BeginTrans
.Execute strSQL, p_lRowsUpdated, dbFailOnError
If Err.Number <> 0 Then
.RollbackTrans
GoTo Error_Handler
Else
.CommitTrans
If glbDebugMode Then
Debug.Print "Records Updated : " & p_lRowsUpdated
End If
If p_lRowsUpdated > 0 Then updateTransportRate = True Else updateTransportRate = False
If glbLogApplicationActivity = True And p_lRowsUpdated > 0 Then
Call addActivityLog(SystemLogType.UpdateRecord, "Updated route " & lngOrigin & " -> " & lngDestination & " with rate: " & dblRate & " in tbl_transport")
End If
End If
End With
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number <> 0 Then
If glbDebugMode Then
Select Case DebugOption("Error # " & Err.Number & " was generated by " & Err.Source & " (" & Err.Description & ")")
Case vbAbort, vbIgnore
ProcessError Err.Number, Err.Description, , , "Module", "MAINTENANCE", "Function", "updateTransportRate", Erl, True
Case vbRetry
Stop: Resume 0
End Select
Else
ProcessError Err.Number, Err.Description, , , "Module", "MAINTENANCE", "Function", "updateTransportRate", Erl, True
End If
End If
Resume Error_Handler_Exit
End Function
Below procedure is used in the above error handler to capture response only while in debug mode:
Public Function DebugOption(sErrorMessage As String) As Integer
DebugOption = MsgBox("" & sErrorMessage & "" _
& vbCrLf & "Abort - Stop" _
& vbCrLf & "Retry - Debug (then press F8 twice to show error line)" _
& vbCrLf & "Ignore - Continue with next line", _
Buttons:=vbAbortRetryIgnore Or vbCritical Or vbDefaultButton2, Title:=CurrentDb.Properties("AppTitle"))
End Function
Debug prompt message for testing only:
Below is my error processing procedure which accepts a number of parameters and writes the result to a log file:
Public Sub ProcessError(Optional strErrNumber As String = vbNullString, _
Optional strErrDescription As String = vbNullString, _
Optional intErrSeverity As Integer = 0, _
Optional strErrState As String = vbNullString, _
Optional strErrModuleType As String = vbNullString, _
Optional strErrModuleName As String = vbNullString, _
Optional strErrProcedureType As String = vbNullString, _
Optional strProcedureName As String = vbNullString, _
Optional strErrLineNo As String = vbNullString, _
Optional blnDisplay As Boolean = True)
' declarations ->
Dim strGUID As String
Dim strSQL As String
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
Dim tmpString As String
' build string ->
tmpString = "Error # " & strErrNumber & " (" & strErrDescription & ") on line " & strErrLineNo & " in procedure " & strProcedureName & " of " & strErrProcedureType & " in " & strErrModuleType & " " & strErrModuleName & ""
If glbDebugMode Then Debug.Print tmpString
' check if error logging is enabled ->
If glbErrorLogging Then
' write error log to table ->
strGUID = CreateGuid
' insert log into error table ->
strSQL = "INSERT INTO system_error_log (error_user, error_number, error_description, error_severity, error_state, " & _
"error_module_type, error_module_name, error_procedure_type, error_procedure_name, " & _
"error_line, error_message, rowguid) " & _
"VALUES('" & Application.CurrentUser & "', '" & strErrNumber & "', '" & strErrDescription & "', " & intErrSeverity & ", '" & strErrState & "', " & _
" '" & strErrModuleType & "', '" & strErrModuleName & "', '" & strErrProcedureType & "', '" & strProcedureName & "', " & _
" '" & strErrLineNo & "', '" & Replace(tmpString, "'", "''") & "', '" & strGUID & "')"
cnn.Execute strSQL, , dbFailOnError **<---- FAILS HERE**
End If
End Sub
Why would the above error processing procedure fail on cnn.Execute strSQL, , dbFailOnError and then display the same error message from earlier CRUD procedure?
cnn.Execute error message:
Perhaps I am missing something simple here so hopefully someone can point me in the right direction.
Edit with new source code based on changes for review:
Public Function updateRoutePairRate(lngFromLocationNumber As Long, lngToLocationNumber As Long, dblRate As Double) As Boolean
If glbErrorHandling Then On Error GoTo Error_Handler
Dim prm_FromLocationNumber As ADODB.Parameter
Dim prm_ToLocationNumber As ADODB.Parameter
Dim prm_Rate As ADODB.Parameter
strSQL = "UPDATE tbl_transport " & _
"SET PalletRate =?, EffectiveDTS =Now(), LastUpdateUserID ='" & Application.CurrentUser & "' " & _
"WHERE FromLocNo=? AND ToLocNo=?"
' set connection and command objects ->
Set cnn = CurrentProject.Connection
Set cmd = New ADODB.Command
With cmd
' create and append parameters ->
Set prm_Rate = .CreateParameter("PalletRate", adDouble, adParamInput, , dblRate)
.Parameters.Append prm_Rate
Set prm_FromLocationNumber = .CreateParameter("FromLocNo", adInteger, adParamInput, , lngFromLocationNumber)
.Parameters.Append prm_FromLocationNumber
Set prm_ToLocationNumber = .CreateParameter("ToLocNo", adInteger, adParamInput, , lngToLocationNumber)
.Parameters.Append prm_ToLocationNumber
.Parameters.Refresh
For Each param In cmd.Parameters
Debug.Print param.Name, param.Value
Next
.ActiveConnection = cnn ' set the connection
.CommandText = strSQL ' set command text to SQL
.CommandType = adCmdText ' set command type
.Execute p_lRowsUpdated ' execute command
End With
If p_lRowsUpdated > 0 Then updateRoutePairRate = True Else updateRoutePairRate = False
End With
Error_Handler_Exit:
On Error Resume Next
Set cnn = Nothing
Set cmd = Nothing
Exit Function
Error_Handler:
If Err.Number <> 0 Then
If glbDebugMode Then
Select Case DebugOption("Error # " & Err.Number & " was generated by " & Err.Source & " (" & Err.Description & ")")
Case vbAbort, vbIgnore
ProcessError Err.Number, Err.Description, , , "Module", "MAINTENANCE", "Function", "updateRoutePairRate", Erl, True
Case vbRetry
Stop: Resume 0
End Select
Else
ProcessError Err.Number, Err.Description, , , "Module", "MAINTENANCE", "Function", "updateRoutePairRate", Erl, True
End If
End If
Resume Error_Handler_Exit
End Function

Access Export Query to Spreadsheet subject to variable conditions?

I have a form with a button, 2 combo boxes as filters, and 3 combo boxes to sort. This button successfully opens a report (trndOTRpt, whose data comes from the query trndOTQry) subject to any criteria that may be chosen and sorted by any sort criteria that may be chosen. I changed the command to instead export the driving query, trndOTQry:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, _
"trndOTQry", _
"\\es3.com\dfsroot$\YK_Share\office_public\D2S\D2S\D2S_Scorecard\OTTest.xls"
This works successfully. But now I want to apply the same VBA code to filter/sort this query as I did with the report. Here is the whole of it:
(The meat & potatoes is at the bottom, notice the commented out code from the original script to open the report. I simply subbed that for the above TransferSpreadsheet action.)
Private Sub SupervisorsGo_Click()
Dim strWhereCondition As String
Dim strSupervisor As String
Dim strPosition As String
Dim varItem As Variant
For Each varItem In Me.SupervisorCombo.ItemsSelected
strSupervisor = strSupervisor & ",'" & Me.SupervisorCombo.ItemData(varItem) _
& "'"
Next varItem
If Len(strSupervisor) = 0 Then
strSupervisor = "Like '*'"
Else
strSupervisor = Right(strSupervisor, Len(strSupervisor) - 1)
strSupervisor = "IN(" & strSupervisor & ")"
End If
For Each varItem In Me.PositionCombo.ItemsSelected
strPosition = strPosition & ",'" & Me.PositionCombo.ItemData(varItem) _
& "'"
Next varItem
If Len(strPosition) = 0 Then
strPosition = "Like '*'"
Else
strPosition = Right(strPosition, Len(strPosition) - 1)
strPosition = "IN(" & strPosition & ")"
End If
strWhereCondition = "[supervisor] " & strSupervisor & _
" AND [position] " & strPosition
If Me.cboSortOrder1.Value <> "Not Sorted" Then
strSortOrder = "[" & Me.cboSortOrder1.Value & "]"
If Me.cmdSortDirection1.Caption = "Descending" Then
strSortOrder = strSortOrder & " DESC"
End If
If Me.cboSortOrder2.Value <> "Not Sorted" Then
strSortOrder = strSortOrder & ",[" & Me.cboSortOrder2.Value & "]"
If Me.cmdSortDirection2.Caption = "Descending" Then
strSortOrder = strSortOrder & " DESC"
End If
If Me.cboSortOrder3.Value <> "Not Sorted" Then
strSortOrder = strSortOrder & ",[" & Me.cboSortOrder3.Value & "]"
If Me.cmdSortDirection3.Caption = "Descending" Then
strSortOrder = strSortOrder & " DESC"
End If
End If
End If
End If
Debug.Print strWhereCondition
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, _
"trndOTQry", _
"\\es3.com\dfsroot$\YK_Share\office_public\D2S\D2S\D2S_Scorecard\OTTest.xls"
' DoCmd.OpenReport "trndOTRpt", View:=acViewPreview, _
' WhereCondition:=strWhereCondition
With Queries![trndOTQry]
.OrderBy = strSortOrder
.OrderByOn = True
End With
End Sub
This fails. While the original code went With Reports![trndOTRpt], I get Run-time Error 424: Object Required with With Queries![trndOTQry] highlighted. I feel like I have adjusted all references appropriately--why is it not acknowledging the object here?
My goal is to export trndOTQry subject to filters/sorts chosen in the form.