VBA DAO.OpenRecordSet Inconsistent Errors - vba

Running Access 2016
I am attempting to import data from an MS Access .mdb table from Excel. (The proprietary software my client uses only recognizes *.mdb files.) When I run this code when the table is closed, I get the error:
Run-Time Error 3061
Too few parameters - Expected 2
If I run the code when the table is open in Access, HALF the time, I get that error and half the time I get:
Run-Time error '3008'
The table 'Daily_Logs_of_Flows' is already opened exclusively by
another user, or it is already open through the user interface
and cannot be manipulated programmatically.
That seems to indicate that VBA gets past the first error sometimes.
I have checked variable names and have used both single quotations in and number signs (#) before and after monthToImport because of this post on StackOverflow. The error went from
Expected 3
to
Expected 2
Here is the code
Sub importPLCDataFromAccess(monthToImport As Date)
Dim myDbLocation As String
myDbLocation = "K:\Users\WWTP Computer\Documents\POV_Projects\PLC Interface\PLC_Data.mdb"
DIM mySQLCall as String
Set myWorkbook = ActiveWorkbook
Set myDataSheet = myWorkbook.Worksheets("Page 1")
Set myEngine = New DAO.DBEngine
'Set myWorkspace = myEngine.Workspaces(0)
Set myDB = myEngine.OpenDatabase(myDbLocation)
' I deleted the workspace
' Set myDB = myWorkspace.OpenDatabase(myDbLocation)
mySQLCall = "SELECT Time_Stamp, GolfVolume, CreekVolume, InfluentVolume FROM Daily_Logs_of_Flows "
' Limit records to month requested...
mySQLCall = mySQLCall & "WHERE (DATEPART(m,Time_Stamp) = DATEPART(m,#" & monthToImport & "#)) "
' ... during the year requested
mySQLCall = mySQLCall & "AND (DATEPART(yyyy,Time_Stamp) = DATEPART(yyyy,#" & monthToImport & "#)) "
mySQLCall = mySQLCall & "ORDER BY Time_Stamp"
Debug.Print "mySQLCall = " & mySQLCall
Debug.Print "monthToImport: " & monthToImport
'Error occurs on next line where execute query & populate the recordset
Set myRecordSet = myDB.OpenRecordset(mySQLCall, dbOpenSnapshot)
'Copy recordset to spreadsheet
Application.StatusBar = "Writing to spreadsheet..."
Debug.Print "RecordSet Count = " & myRecordSet.recordCount
If myRecordSet.recordCount = 0 Then
MsgBox "No data retrieved from database", vbInformation + vbOKOnly, "No Data"
GoTo SubExit
End If
'....
End Sub
Here is the Debug.Print of SQL statement as currently reads:
mySQLCall = SELECT Time_Stamp, GolfVolume, CreekVolume, InfluentVolume FROM Daily_Logs_of_Flows WHERE (DATEPART(m,Time_Stamp) = DATEPART(m,#6/1/2016#)) AND (DATEPART(yyyy,Time_Stamp) = DATEPART(yyyy,#6/1/2016#)) ORDER BY Time_Stamp
Any thoughts on what I am missing here? Thanks in advance for your help.

The problem is that the DATEPART function needs the first parameter in quotes, otherwise it looks for the field yyyy or m.
For example:
DATEPART("yyyy", #6/1/2016#)
or
DATEPART("m", #6/1/2016#)
In total:
SELECT Time_Stamp, GolfVolume, CreekVolume, InfluentVolume _
FROM Daily_Logs_of_Flows
WHERE (DATEPART("m",Time_Stamp) = DATEPART("m",#6/1/2016#))
AND (DATEPART("yyyy",Time_Stamp) = DATEPART("yyyy",#6/1/2016#))
ORDER BY Time_Stamp
To do this in VBA (in case you don't know, but I'm guessing you do), just double up the quotation marks each time you call the DATEPART function...
For example:
mySQLCall = mySQLCall & "AND (DATEPART(""yyyy"",Time_Stamp)...."
Just to be complete, Run-Time error '3008' is actually the first error....Access won't attempt to run any SQL until it can determine that it has the proper permissions.

Related

MS Access filtering for date causes Error 3075

I have a text field, called DateSelector that is formatted as a Short Date, and a subform with a list of entries, one column named ControlDate contains values that are formatted as Short Date as well.
What I want:
If you change the value of DateSelector it is supposed to filter the column ControlDate to between now and the value of DateSelector, or at least be below that of DateSelector.
This is the code I have:
Private Sub DateSelector_AfterUpdate()
On Error GoTo Proc_Error
If Me.DateSelector.Value = "" Then
Me.ListView.Form.filter = ""
Me.ListView.Form.FilterOn = False
Else
MsgBox (Me.DateSelector.Value)
'This is a Check, if the Value is correct.
Me.ListView.Form.filter = "ControlDate >=" & Me.DateSelector.Value
Me.ListView.Form.FilterOn = True
End If
Proc_Exit:
Exit Sub
Proc_Error:
MsgBox "Error " & Err.Number & " when creating Filter:" & vbCrLf & Err.Description
Resume Proc_Exit
End Sub
The error thrown is 3075: Syntax Error. The MsgBox shows the correct date, where the error message shows the date missing the last digit (e.g.: 05.12.2018 --> 05.12.201) and I have absolutely no clue why.
I am thankfull for any answers, thank you for reading,
_Ninsa
You filter will end up as:
"ControlDate >= 01.12.2018"
which Access cannot read. So, apply a proper format of the string expression of the date value:
"ControlDate >= #" & Format(Me!DateSelector.Value, "yyyy\/mm\/dd") & "#"

SQL - Save record with listbox and textbox change

I have a list box - The user clicks one of the results in the list box that's populated from a table.
When they click one of the items in a list box the text boxes populate the results that are in the table
On the textbox I have on change code of:
DoCmd.RunSQL "UPDATE tbl_ComplaintsCoded SET [TicketNumber] = '" & Text3 & "' WHERE ID = " & List1.Column(0)
Text3 shows the Ticket number
Text5 shows the department
Its the department that the user is trying to change before getting an error of:
data type mismatch in criteria expression
Thanks for the help
Just for fun, I rewrote what you put together in something a little more elegant with some basic error handling and a little more streamlined.
Option Compare Database
'Added the option explicit to verify your variables
Option Explicit
Private Sub Button_Click()
'ERROR HANDLING
On Error GoTo Button_Click_Err_Handler
Dim rs As DAO.Recordset
'Is your TicketNumber column a Text data type? Me.List1.Column(0) should return a variant value, so assuming
'your TicketNumber column is of a number type as the name implies, I think you could just use:
'Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_name WHERE TicketNumber = " & Me.list1.Column(0))
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_name WHERE TicketNumber = '" & Me.list1.Column(0) & "'")
'You should always check for BOF and EOF if you're checking if there is no record.
If rs.BOF And rs.EOF Then
MsgBox "You have not selected a record, nothing to save!", vbInformation
'Exiting here, instead of wrapping the entire sub in the if... ...end if statement. You could also just use "Exit Sub", but I added
'the exit and error handling to make it a little more graceful.
GoTo Button_Click_Exit
End If
'I wrapped the rs edits in a with statement and used the direct column name operator ! instead of the collection searching rs() feature.
'For illustration, I wrapped a few of the references in the Nz() function. If none of the fields are ever null, bravo to you for excellent
'database design and database users discipline, but I almost always have a couple columns where nulls are allowed.
With rs
.Edit
'Top Categories
!Business = Me.Text5
!Status = Me.Text8
!MailDate = Me.Text10
'Complaint Detail Section
!Type = Me.Text19
!Sub = Me.Text21
!c = Me.Text23
'Complaint Coding Section
!touch2 = Me.Combo29
!touch1 = Me.Combo33
!Cause2 = Me.Combo31
!cause1 = Me.Combo35
'CS Account Details Section
!Account = Me.Text39
!Feed = Me.Combo41
'Logged Audit User
!LoggedUser = Me.Text43
!DateTimeLogged = Me.Text49
.Update
End With
'EXIT PROCEDURE
Button_Click_Exit:
On Error Resume Next
Exit Sub
'ERROR HANDLING
Button_Click_Err_Handler:
MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "Error"
Resume Button_Click_Exit
End Sub
I solved this by doing this instead:
Set db = CurrentDb
Set rec = db.OpenRecordset("Select * from tbl_name WHERE TicketNumber = '" & Me.List1.Column(0) & "'")
If rec.EOF Then
MsgBox "You have not selected a record, nothing to save!", vbInformation
Else
rec.Edit
'Top Categories
rec("Business") = Me.Text5
rec("Status") = Me.Text8
rec("MailDate") = Me.Text10
'Complaint Detail Section
rec("Type") = Me.Text19
rec("Sub") = Me.Text21
rec("C") = Me.Text23
'Complaint Coding Section
rec("touch2") = Me.Combo29
rec("touch1") = Me.Combo33
rec("Cause2") = Me.Combo31
rec("cause1") = Me.Combo35
'CS Account Details Section
rec("Account") = Me.Text39
rec("Feed") = Me.Combo41
'Logged Audit User
rec("LoggedUser") = Me.Text43
rec("DateTimeLogged") = Me.Text49
rec.Update

Trying to use VBA to write query in Access

I am getting a type mismatch with the following syntax in my Access VBA. I am trying to update my table named "Billing" by seeing if any records have a date that looks at a string value in my "Certs" table like "2012-07-01" corresponding to my form's billYear textbox e.g. 2012 and my billMonth textbox e.g. 07. Is there a better way to write the VBA or see an error - many thanks:
Dim sRecert As String
Dim byear As Integer
Dim bmonth As Integer
byear = Me.billYear
bmonth = Me.billMonth
sRecert = "Update Billing set recertifying = -1 where (select certificationExpireDate from certs where Left((certificationExpireDate),4) = " & byear
& " and Mid((certificationExpireDate),6,2) = " & bmonth & ")"
DoCmd.RunSQL sRecert
I may not have explained it well. I created a real Query called from my form:
DoCmd.OpenQuery "updateRecert"
I set up my SQL below as a test on a real date I’m working with. It is in SQL Server (ODBC linked)
My dbo_certs table and my dbo_billing table share only one joinable field peopleID:
UPDATE dbo_Billing AS a INNER JOIN dbo_certs AS b ON a.peopleid = b.peopleid
SET a.recertifying = -1
WHERE b.certificationExpireDate = '2015-08-31 00:00:00.000';
The above gave a data mismatch error.
My bottom line is I have two text boxes on my form to pass in data preferably into my VBA code:
billMonth which in this case is 8 because it is an integer so that is
a problem
billYear is 2015
so I need to update my dbo_billing table’s ‘recertifying’ field with -1 if the dbo_cert’s field ‘certificationExpireDate’ is '2015-08-31 00:00:00.000' but only if that can be gotten from the form.
Is there a better way to write the VBA or see an Error?
Yes. You need Error Handling
I don't think the issue is in the code, I think it's in the SQL.
To troubleshoot your code, wrap it in an good error handler.
Public Sub MyRoutine()
On Error GoTo EH
'put your code here
GoTo FINISH
EH:
With Err
MsgBox "Error" & vbTab & .Number & vbCrLf _
& "Source" & vbTab & .Source & vbCrLf & vbCrLf _
& .Description
End With
'for use during debugging
Debug.Assert 0
GoTo FINISH
Resume
FINISH:
'any cleanup code here
End Sub
When the msgbox shows the error, make note of the Source. This should help you determine where the error comes from.
The lines following 'for use during debugging are helpful. Here's how to use them:
execution will stop on the Debug.Assert 0 line
drag the yellow arrow (which determines which line to run next) to the Resume line
hit {F8} on the keyboard (or use the menu Debug > Step Into)
This will go to the line where the error occurred. In your case, it will probably be the last line of your code.
Error in SQL... but!! Are you sure that certificationExpireDate is string and all the time equal to yyyy-mm-dd pattern?? It's dangerouse to have relation with "not certain" key like you have. I think this is not a good db design.
But, after all, for your case:
VBA:
sRecert = "UPDATE Billing a inner join certs b " & _
"on format(a.imaginary_date_field, """yyyy-mm-dd""") = b.certificationExpireDate " & _
"set a.recertifying = -1 " & _
"where CInt(Left((b.certificationExpireDate),4)) = " & byear & " and CInt(Mid((b.certificationExpireDate),6,2)) = " & bmonth
QueryDef:
PARAMETERS Forms!your_form!byear Short, Forms!your_form!bmonth Short;
UPDATE Billing a inner join certs b
on format(a.imaginary_date_field, "yyyy-mm-dd") = b.certificationExpireDate
set a.recertifying = -1
where CInt(Left((b.certificationExpireDate),4)) = Forms!your_form!byear and CInt(Mid((b.certificationExpireDate),6,2)) = Forms!your_form!bmonth
UPDATED
mismatch error
You get error probable because you have date/time field, not a string. Date in MS Access queries write with # symbol. WHERE b.certificationExpireDate = #2015-08-31 00:00:00.000#;
In your case:
PARAMETERS Forms!your_form!byear Short, Forms!your_form!bmonth Short;
UPDATE dbo_Billing AS a INNER JOIN dbo_certs AS b ON a.peopleid = b.peopleid
SET a.recertifying = -1
WHERE year(b.certificationExpireDate) = Forms!your_form!byear and Month(b.certificationExpireDate) = Forms!your_form!bmonth;
For more info follow this link

MS access sum results between two dates as text box in form

I issue following query in SQL and works fine
SELECT SUM(goudOpkoop.winst)
FROM goudOpkoop
WHERE goudOpkoop.date
BETWEEN '2015-1-10' AND '2015-1-22'
I would like to have the results in a Form in Textbox 3 (name Text183) when last of two dates, one in Textbox 1 (name Text179) and other in textbox 2 (name Text181) have been picked.
I think I would need to use AfterUpdate code builder for Textbox 2 and issue there the query to eventually show results in Textbox 3.
I have already linked with SQL server.
Information: ODBC;DSN=Essence Test;;TABLE=goudOpkoop
In me not being a professional in VBA I have no clue how to get this working.
Not tested, but should do the trick slightly, unless I made a typo.
Change the format of your 2 dates textboxes in "Short Date", that way you will have a calendar picker and you will ensure that your date have a correct format
Create this sub in your form module :
Private Sub CheckSUM()
Dim RST As Recordset
Dim SQL As String
' Reset the result textbox
Text183.value = ""
' If your 2 date textboxes are not populated, cancel
If Text179.Value = "" or Text181.Value = "" Then Exit Sub
' Prepare the query, with proper formating of the dates
SQL = " SELECT SUM(goudOpkoop.winst) AS mySum " & _
" FROM goudOpkoop " & _
" WHERE goudOpkoop.Date " & _
" BETWEEN '" & Format(Text179.Value, "YYYY-MM-DD") & "' " & _
" AND '" & Format(text181.Value, "YYYY-MM-DD") & "'"
' Execute the query
Set RST = CurrentDb.OpenRecordset(SQL)
' If the query is valid and returned something, we recuperate the value
If Not RST.BOF Then
Text183.Value = RST!mySum
End If
' Cleaning
RST.Close
Set RST = Nothing
End Sub
Then, for your 2 dates textboxes, create an afterupdate event and call the previous sub in them:
Private Sub Text179_AfterUpdate()
CheckSUM
End Sub
Private Sub Text181_AfterUpdate()
CheckSUM
End Sub

Access VBA Object Required Error

This has probably been answered before, but in looking, I could not find an answer that suited my situation. I am coding an Access 2003 form button to run an If/Then and do some commands based on that statement when clicked. However I am getting the 'Object Required' error on every click. I am still relatively new to VBA code, so please be gentle.
Here is the code:
Private Sub Button_Click()
On Error GoTo Err_Button_Click
Dim Db As Object
Set Db = CurrentDb
Dim waveset As DAO.Recordset
Set waveset = Db.OpenRecordset("SELECT countervalue FROM dbo_tblSettings")
Dim orderfile As String
orderfile = "\\serverfolder\serverfile.csv"
If Value.waveset > 0 Then
MsgBox "Orders Already Imported; Please Proceed to Next Step", vbOKOnly, "Step Complete"
GoTo Exit_Button_Click
ElseIf Value.waveset = 0 Then
DoCmd.RunSQL "DELETE FROM dbo_tblOrders", True
DoCmd.TransferText acImportDelim, , "dbo_tblOrders", orderfile, True
DoCmd.RunSQL "UPDATE dbo_tblOrders INNER JOIN dbo_MainOrderTable ON dbo_tblOrders.[channel-order-id]=dbo_MainOrderTable.[order-id] " _
& "SET dbo_MainOrderTable.[order-id] = dbo_tblOrders.[order-id], dbo_MainOrderTable.[channel-order-id] = dbo_tblOrders.[channel-order-id], " _
& "dbo_MainOrderTable.[Order-Source] = 'Amazon'" _
& "WHERE dbo_tblOrders.[sales-channel]='Amazon';", True
DoCmd.RunSQL "UPDATE dbo_AmazonOrderTable INNER JOIN dbo_tblOrders ON dbo_AmazonOrderTable.[order-id]=dbo_tblOrders.[channel-order-id] " _
& "SET dbo_AmazonOrderTable.[order-id] = dbo_tblOrders.[order-id], dbo_AmazonOrderTable.[channel-order-id] = dbo_tblOrders.[channel-order-id], " _
& "dbo_AmazonOrderTable.[sales-channel] = 'Amazon' " _
& "WHERE dbo_tblOrders.[sales-channel]='Amazon';", True
DoCmd.RunSQL "UPDATE dbo_tblSettings SET countervaule=1", True
Else
GoTo Exit_Button_Click
End If
Exit_Button_Click:
Exit Sub
Err_Button_Click:
MsgBox Err.Description
Resume Exit_Button_Click
End Sub
-OH! forgot to mention I want to do it this way because the tables are actually linked tables to a SQL server back-end... I've also been trying to figure out how to open the connection to my SQL server and manipulate the tables via the VBA code without having to link them in Access... but that's another post altogether
Any help will be greatly appreciated. Thanks
I think the problem is the line
If Value.waveset > 0 Then
Which should be
waveset.Value > 0 Then
.Value is a property - it comes after the object, but it is not itself an object. Thus, asking for the .waveset property of Value will give an error.
The same thing happens again a few lines later:
ElseIf Value.waveset = 0 Then
The advice that #HansUp gave in his comment is a good one. Write Option Explicit at the top of your module, then hit Debug->Compile. Your code will generate errors. Add statements of the form
Dim waveset
to the top of your function. Only declare variables you intend to use. Any remaining errors are now due to typos or other syntax / logic errors, and will be spotted more easily.
If you are sure you know what type a particular variable will be, it is marginally more efficient to declare as that type; so
Dim ii As Integer
For ii = 0 To 10000
...
is marginally more efficient than
Dim ii
For ii = 0 To 10000
But that's not what your question is about.
Yes, ...If Value.waveset > 0 ... does give an error Object Required
BOTH lines need to be changed, but need to be this syntax ---
If waveset.Fields("countervalue").Value > 0
...
ElseIf waveset.Fields("countervalue").Value = 0 Then