I was using the following SQL - This worked fine
Set rs1 = CurrentDb.OpenRecordset("SELECT Count(Advisors) AS TotalNumber FROM tbl_ComplaintsCoded WHERE Advisors = '" & Forms!frm_Central_Reporting_ops!Text52.Value & "' AND Year([Mail Date]) = " & Me.Text48.Value & " AND month([Mail Date]) =4")
I have made a slight change to:
Set rs1 = CurrentDb.OpenRecordset("SELECT Count(PolicyComplaints) AS TotalNumber FROM tbl_ComplaintsCoded WHERE PolicyComplaints = '" & Forms!frm_Central_Reporting_ops!Text52.Value & "' AND Year([Mail Date]) = " & Me.Text48.Value & " AND month([Mail Date]) =4")
The error is:
Data type mismatch in expression
I cant work out at all what has gone so drastically wrong?
Help
You cannot surround calculated field with single quotation marks. Remove the quotation marks and it should work. Here is an example:
Private Sub showQueryData()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sqlStr As String
sqlStr = "SELECT COUNT(CalculatedField) AS TotalNumber FROM table1 AS tbl WHERE CalculatedField = '2'"
Set db = CurrentDb
Set rs = db.OpenRecordset(sqlStr)
Dim result As String
result = rs!TotalNumber
End Sub
above method will error out due to query parameter '2'. It will work when you remove quotations as below:
Private Sub showQueryData()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sqlStr As String
sqlStr = "SELECT COUNT(CalculatedField) AS TotalNumber FROM table1 AS tbl WHERE CalculatedField = 2"
Set db = CurrentDb
Set rs = db.OpenRecordset(sqlStr)
Dim result As String
result = rs!TotalNumber
End Sub
I have rewritten your code without surrounding quotations which works in my end:
Set rs1 = CurrentDb.OpenRecordset("SELECT Count(PolicyComplaints) AS TotalNumber FROM tbl_ComplaintsCoded WHERE PolicyComplaints = " & Forms!frm_Central_Reporting_ops!Text52.Value & " AND Year([Mail Date]) = " & Me.Text48.Value & " AND month([Mail Date]) =4")
Related
I am running some code to split a slash-separated field into multiple rows, but the first value in the series is not carrying over. Does anyone know what I'm missing. Also, Rows that only have one record are not carrying over.
Public Sub ReformatTable()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsADD As DAO.Recordset
Dim strSQL As String
Dim strMPG, strBusinessName, strCustomerNumber, strCustomerName, strCountStartDate, strCCStatus As String
Dim strSplitMPG As String
Dim varData As Variant
Dim i As Integer
Set db = CurrentDb
' Select all eligible fields (have a comma) and unprocessed (SPLIT_MPG is Null)
strSQL = "SELECT BUSINESS_NAME, CUSTOMER_NUMBER, CUSTOMER_NAME, COUNT_START_DATE, CC_STATUS, MPG, SPLIT_MPG FROM [tmStarCycleCountStatuses_SlashesforCommas] WHERE ([MPG] Like ""*/*"") AND ([SPLIT_MPG] Is Null)"
Set rsADD = db.OpenRecordset("tmStarCycleCountStatuses_SlashesforCommas", dbOpenDynaset, dbAppendOnly)
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
With rs
While Not .EOF
strMPG = !MPG
strBusinessName = !BUSINESS_NAME
strCustomerNumber = !CUSTOMER_NUMBER
strCustomerName = !CUSTOMER_NAME
strCountStartDate = !COUNT_START_DATE
strCCStatus = !CC_STATUS
varData = Split(strMPG, "/") ' Get all comma delimited fields
' Update First Record
.Edit
!SPLIT_MPG = Trim(varData(0)) ' remove spaces before writing new fields
.Update
' Add records with same first field
' and new fields for remaining data at end of string
For i = 1 To UBound(varData)
With rsADD
.AddNew
!MPG = strMPG
!SPLIT_MPG = Trim(varData(i)) ' remove spaces before writing new fields
!BUSINESS_NAME = strBusinessName
!CUSTOMER_NUMBER = strCustomerNumber
!CUSTOMER_NAME = strCustomerName
!COUNT_START_DATE = strCountStartDate
!CC_STATUS = strCCStatus
.Update
End With
Next
.MoveNext
Wend
.Close
rsADD.Close
End With
Set rsADD = Nothing
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
I can't post images yet due to reputation constrictions, but here are some links.
Here's the multiple after the code:
https://s9.postimg.org/fn3u70b5b/Multiple.jpg
Here's the single records after code run:
https://s10.postimg.org/bfq9z4snt/Singles.jpg
I feel like there's something super simple that I'm missing here, but it looks like I'm already taking the MPG over, so i'm curious as to why I'm not getting the singles or the first of the series. Any help would be appreciated! Thank you.
It looks right to me, except that you have to declare like this:
Dim strMPG As String
Dim strBusinessNames As String
Dim strCustomerNumbers As String
Dim strCustomerNames As String
Dim strCountStartDates As String
Dim strCCStatus As String
I guess you will have to insert some lines with Debug.Print .. to narrow down the happenings.
Got it. Ended up changing my approach. This code will work. The pattern, regardless of length, would always be the same, so I used a Right/Left combo and integers
Public Sub ReformatmStarCycleCountStatusesTable()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strMPG As String
Dim strBusinessName As String
Dim strCustomerNumber As String
Dim strCustomerName As String
Dim dteCountStartDate As Date
Dim strCCStatus As String
Dim strSplitMPG As String
Dim intRemainingLength As Integer
Dim intInitialLength As Integer
Dim intStartPoint As Integer
Dim varData As Variant
Set db = CurrentDb
DoCmd.SetWarnings False
' Select all eligible fields (have a comma)
strSQL = "SELECT * FROM [mStar Cycle Count Statuses] WHERE [PRODUCT_FILTER_VALUE] is not null"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
With rs
While Not .EOF
strMPG = !PRODUCT_FILTER_VALUE
strBusinessName = !BUSINESS_NAME
strCustomerNumber = !CUSTOMER_NUMBER
dteCountStartDate = !COUNT_START_DATE
strCCStatus = !Status
intInitialLength = Len(strMPG)
intRemainingLength = intInitialLength
intStartPoint = 2
Do While intRemainingLength > 0
strSQL = "INSERT INTO tmStarCycleCountStatuses VALUES ('" & strBusinessName & "', '" & strCustomerNumber _
& "', #" & dteCountStartDate & "#, '" & strCCStatus & "', '" & Right(Left(strMPG, intStartPoint), 2) & "')"
DoCmd.RunSQL (strSQL)
intStartPoint = intStartPoint + 3
intRemainingLength = intRemainingLength - 3
Loop
intStartPoint = 1
.MoveNext
Wend
.Close
End With
DoCmd.SetWarnings True
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
I can't work out where I am going wrong with my code. When the user selects a value in the combo box, i want it to go to the Consultants table and grab the default rate for that consultant and stick it in the Hourly Rate text box. This is the msg that I get when I update the combobox.
Private Sub cmbConsultant_Change()
Dim db As Database
Dim rs As DAO.Recordset ''Requires reference to Microsoft DAO x.x Library
Dim strSQL As String
strSQL = "defaultFee * FROM tblConsultants WHERE ID = """ & Me!cmbConsultant & """"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
If rs.RecordCount > 0 Then
Me.txtHourlyRate = rs!CountOfEndDeviceType
Else
Me.txtHourlyRate = ""
End If
Set rs = Nothing
Set db = Nothing
End Sub
You could use DLookup for this - much simpler:
Private Sub cmbConsultant_Change()
Me!txtHourlyRate.Value = DLookup("defaultFee", "tblConsultants", "ID = '" & Me!cmbConsultant.Value & "'")
End Sub
However, most likely your ID is numeric, thus:
Private Sub cmbConsultant_Change()
Me!txtHourlyRate.Value = DLookup("defaultFee", "tblConsultants", "ID = " & Me!cmbConsultant.Value & "")
End Sub
I Think You need some SELECT Here
strSQL = "defaultFee * FROM tblConsultants WHERE ID = """ & Me!cmbConsultant & """"
It Should Be:
strSQL = "SELECT defaultFee AS [CountOfEndDeviceType] FROM tblConsultants WHERE ID = """ & Me!cmbConsultant & """"
Also Note, That [CountOfEndDeviceType] Must be a FieldName, SO I've put it in a Select statement.
Error: "Run-time error '3061' Too few parameters. Expected 2.
I wrote this simple function that returns the remaining percentage calculated for number of records changed. It is supposed to occur when the user updates the field called 'percentage' I am certain the code below should work, but obviously something is wrong. It occurs on the line:
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
I wonder how it could fail when the very same query is what populates the 'record source' for the form with the 'percentage' textbox.
Function RemainingPercentAvailable() As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
Dim CurrentTotal As Single
CurrentTotal = 0
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
CurrentTotal = CurrentTotal + rs!Percentage
rs.MoveNext
Loop
End If
RemainingPercentAvailable = "Remaing available: " & Format(1 - CurrentTotal, "0.000%")
Set rs = Nothing
Set db = Nothing
End Function
Adapt your code to use the SELECT statement with a QueryDef, supply values for the parameters, and then open the recordset from the QueryDef.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Tier1, [Percentage], Tier3 AS Battalion, [Month] " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND (([Month])=[Forms]![frmEntry]![cmbMonth]));"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSQL )
' supply values for the 2 parameters ...
qdf.Parameters(0).Value = Eval(qdf.Parameters(0).Name)
qdf.Parameters(1).Value = Eval(qdf.Parameters(1).Name)
Set rs = qdf.OpenRecordset
Note: Month is a reserved word. Although that name apparently caused no problems before, I enclosed it in square brackets so the db engine can not confuse the field name with the Month function. It may be an unneeded precaution here, but it's difficult to predict exactly when reserved words will create problems. Actually, it's better to avoid them entirely if possible.
This one is calling a query directly in a DAO.Recordset and it works just fine.
Note the same 'Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) This is a parameter SQL as well.
The only difference is with this one is that I DIDN'T need to move through and analyze the recordset - but the error occurs on the 'Set rs = " line, so I wasn't able to get further anyway.
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
strSQL = "SELECT Sum(tbl_SP.AFP) AS AFP_TOTAL, tbl_SP.T1_UNIT " _
& "FROM tbl_SP " _
& "GROUP BY tbl_SP.T1_UNIT " _
& "HAVING (((tbl_SP.T1_UNIT)='" & strUnit & "'));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
AFP_Total = rs!AFP_Total
There is an even simpler way to calculate the total percentage.
Instead of looping through the records, you can use the DSum() function.
Note that DSum will return Null if there are no records, so you need to wrap it in Nz().
Just for fun, here is your function but written as one single statement:
Function RemainingPercentAvailable() As String
RemainingPercentAvailable = "Remaining available: " & Format(1 - _
Nz(DSum("Percentage", _
"tbl_CustomPercent", _
"Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth))) _
, "0.000%")
End Function
I don't recommend building a temporary parameterized query in VBA, because it makes the code too complicated. And slower. I prefer to build "pure" SQL that will run directly in the db engine without any callbacks to Access. I'm assuming that your function is defined in the frmEntry form, and that cmbImport_T1 and cmbMonth are string fields. If they are numeric, omit qString().
Here is my version of your function. It handles the empty-recordset case correctly.
Function RemainingPercentAvailable() As String
Dim CurrentTotal As Double, q As String
q = "SELECT Percentage" & _
" FROM tbl_CustomPercent" & _
" WHERE Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth)
CurrentTotal = 0
With CurrentDb.OpenRecordset(q)
While Not .EOF
CurrentTotal = CurrentTotal + .Fields("Percentage")
.MoveNext
Wend
End With
RemainingPercentAvailable = "Remaining available: " & _
Format(1 - CurrentTotal, "0.000%")
End Function
' Return string S quoted, with quotes escaped, for building SQL.
Public Function QString(ByVal S As String) As String
QString = "'" & Replace(S, "'", "''") & "'"
End Function
I'm trying to open a record set using a SQL string. I get run time error 3061 "Too Few Parameters." any help would be appreciated.
Dim stAppName As String
Dim stURL As String
Dim rst As Recordset
Dim dbs As Database
Dim stringToSearch As Integer
Dim strSQL As String
Set dbs = CurrentDb
stringToSearch = InputBox("What is your route #?", "Enter route #: ")
strSQL = "SELECT ESRP.* FROM ESRP WHERE ESRP.Route=stringToSearch"
Set rst = dbs.OpenRecordset(strSQL)
Please change the code line of strSQL as follows, as suggested by Fionnuala you need to use variable outside the quotes.
Assuming Route field is Text data type, we need to put single quote for strings, if its number no single quote, for dates put # instead of single quote
strSQL = "SELECT ESRP.* FROM ESRP WHERE ESRP.Route='" & stringToSearch & "'"
It's a little sample, maybe it can help you
Public Function fn_SQL_dbOpenRecordset(Optional vsql As String = "") As Recordset
Dim dbs As DAO.Database
Dim rs As Recordset
On Error GoTo END_CODE
'Set the database
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset(vsql, dbOpenForwardOnly) 'you can use: dbOpenDynamic; dbOpenSnapshot; dbOpenTable
Set fn_SQL_dbOpenRecordset = rs
Exit Function
END_CODE:
Set fn_SQL_dbOpenRecordset = Nothing
End Function
Public Sub Program_Test()
On Error GoTo ERROR_SUB
Dim rs As Recordset
Dim sName As String
sName = "Joe"
sName = "'" & sName & "'" 'WARNING: BE CAREFUL WITH SQL INJECTION !!! Google it
Set rs = fn_SQL_dbOpenRecordset("select * from table1 d where PersonName = " & sName)
Dim i As Long
i = 0
While Not rs.EOF
Debug.Print rs(0).Value & " - " & rs(1).Value
rs.MoveNext
Wend
ERROR_SUB:
On Error Resume Next
If Not rs Is Nothing Then rs.Close
Set rs = Nothing
End Sub
I've create an excel userform to collect data. I have connected it to Access to dump the data. However I want to update Access every time a user presses the submit button.
Basically I need the Select statement to determine an id existence, then if it doesn't exists I need to use the INSERT to add the new row. I'm very new with any SQL so any help would be great.
Here is the code I have now, I need to adapt it to ADO.
Sub Update()
Dim cnn As ADODB.Connection
Dim MyConn
Dim rst As ADODB.Recordset
Dim StrSql As String
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:="Foam", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
StrSql = "SELECT * FROM Foam WHERE FoamID = " & txtMyID
Set rst = CurrentDb.OpenRecordset(StrSql, dbOpenDynaset)
If (rst.RecordCount = 0) Then
DoCmd.RunSQL "INSERT INTO Foam (ID, Part, Job, Emp, Weight, Oven) VALUES " & _
"(" & txtID & ", '" & txtField1 & "', '" & txtField2 & "', '" & txtField3 & "', '" & txtField4 & "', '" & txtField5 & "' );"
End If
' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End With
End Sub
I revised your code sample just enough to get it working on my system and tested this version in Excel 2007.
When I use a value for lngId which matches the id of an existing record, that record is opened in the recordset and I can update the values of its fields.
When lngId does not match the id of an existing record, the recordset opens empty [(.BOF And .EOF) = True]. In that situation, I add a new record and add the field values to it.
Sub Update()
Const TARGET_DB As String = "database1.mdb"
Dim cnn As ADODB.Connection
Dim MyConn As String
Dim rst As ADODB.Recordset
Dim StrSql As String
Dim lngId As Long
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn
End With
lngId = 4
StrSql = "SELECT * FROM tblFoo WHERE id = " & lngId
Set rst = New ADODB.Recordset
With rst
.CursorLocation = adUseServer
.Open Source:=StrSql, ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdText
If (.BOF And .EOF) Then
' no match found; add new record
.AddNew
!ID = lngId
!some_text = "Hello World"
Else
' matching record found; update it
!some_text = "Hello World"
End If
.Update
.Close
End With
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Sub
Using VBA, here is a sample of how to query for a certain ID to check if it exists. If it does not then add it via an INSERT statement:
Dim rs As DAO.Recordset
Dim StrSql As String
StrSql = "SELECT * FROM MyTable WHERE ID = " & txtMyID
Set rs = CurrentDb.OpenRecordset(StrSql, dbOpenDynaset)
If (rs.RecordCount = 0) Then
DoCmd.RunSQL "INSERT INTO MyTable (ID, Field1, Field2) VALUES " & _
"(" & txtID & ", '" & txtField1 & "', '" & txtField2 & "');"
End If