all--
I'm attempting to use an SQL query to pull records from an Access db into an Excel VBA userform listbox using the following code:
Sub FillLBBillIDs()
'build bill ID list box with bill IDs available in database, based on client and/or date range
'<---------------------------------------------------Dimension all variables
Dim con As Object, cmd As Object, rst As Object
Dim Path As String, CName As String
Dim FromDate As Date, ToDate As Date
Dim X As Long, Y As Long
'<---------------------------------------------------Define Default Variables
X = 0
CName = AuditParametersFRM.CBOCxName.Value
FromDate = AuditParametersFRM.DTPFrom.Value
ToDate = AuditParametersFRM.DTPTo.Value
'<---------------------------------------------------Define Access connection
Set con = CreateObject("ADODB.Connection"): Set cmd = CreateObject("ADODB.Command"): Set rst = CreateObject("ADODB.RecordSet"):
Path = Sheets("AuditTool").Range("B2").Value
'<---------------------------------------------------Open Access connection
con.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Path & ";Persist Security Info=False;"
con.ConnectionTimeout = 0: con.CommandTimeout = 0: con.Open: cmd.CommandTimeout = 0: Set cmd.ActiveConnection = con
'<---------------------------------------------------Find all bill IDs in the database which match the selected client and
'<---------------------------------------------------are within the consolidated date range
rst.Open "SELECT DISTINCT AdHocReport.[BillID] FROM AdHocReport WHERE AdHocReport.[CxName] = '" & CName & "' AND AdHocReport.[ConsolidationDate] BETWEEN #" & FromDate & "# AND #" & ToDate & "#", con, 1, 3
On Error Resume Next
rst.MoveLast
rst.MoveFirst
Y = 0
Y = rst.RecordCount
AuditToolFRM.LBBillIDs.Clear
If Not Y = 0 Then
Do Until rst.EOF
'<---------------------------------------------------Build the listbox with the acquired information
With AuditToolFRM.LBBillIDs
.AddItem
.List(X, 0) = rst![BillID]
X = X + 1
End With
rst.MoveNext
Loop
End If
rst.Close
On Error GoTo 0
con.Close
End Sub
This code works just fine if I use a greater than argument, thusly:
rst.Open "SELECT DISTINCT AdHocReport.[BillID] FROM AdHocReport WHERE AdHocReport.[CxName] = '" & CName & "' AND AdHocReport.ConsolidationDate > #" & FromDate & "#", con 1, 3
I've gone through all the pertinent questions on this site and can't find anything that works. Any ideas?
Thanks in advance!
12/08/2017 12:54
I've done more testing and it appears that the greater than query isn't working either; it's pulling all records that meet the first criteria whilst ignoring the second, even when using parentheses to enclose the second. This tells me that the issue is definitely in the date portion of the query somehow. Any help is appreciated greatly!
In Access
DATE_FIELD BETWEEN #2/2/2012# AND #2/4/2012#
is the same as
DATE_FIELD >=#2/2/2012# AND <=#2/4/2012#
When you have another AND put parathesis around the date range syntax.
rst.Open "SELECT DISTINCT AdHocReport.[BillID] FROM AdHocReport WHERE AdHocReport.[CxName] = '" & CName & "' AND (AdHocReport.[ConsolidationDate] BETWEEN #" & FromDate & "# AND #" & ToDate & "#)", con, 1, 3
In ADO you must use the ISO sequence in string expressions for date values:
... "' AND AdHocReport.[ConsolidationDate] BETWEEN #" & Format(FromDate, "yyyy\/mm\/dd") & "# AND #" & Format(ToDate, "yyyy\/mm\/dd") & "#" ...
Related
I want to execute a query with a date filter in Access VBA.
My first issue was inconsistent datatypes: expected DATE got NUMBER.
I assume Access stores dates as numbers just like Excel.
I found I had to use "#" between the date for the query to recognize it as a DATE. Now I am getting an INVALID CHARACTER error which means the hash # is an invalid character.
I have to pull in the negotiated costs with our vendors that don't have more than 60 days of being expired.
There is also a tblVendors where the user selects the vendor ID (ORDID) they want to pull the info from. That's why I do a loop to pull in every ORDID in that table. I don't push in all the ORDID in one try because it brings a lot of data and doing it in batches runs faster.
Sub GetMaterialCost()
Dim db As Database
Dim rsData As ADODB.Recordset, rsVendor As DAO.Recordset, rsItemCost As DAO.Recordset
Dim strQuery As String
Dim vendorNO As Long, dtDate As Date
Set db = CurrentDb
dtDate = Format(Now() - 60, "m/d/yyyy")
Set rsVendor = db.OpenRecordset("SELECT ORDID, VEN_NAME, USER_ID FROM tblVendors WHERE ACTIVE = TRUE ORDER BY VEN_NAME, ORDID")
Set rsItemCost = db.OpenRecordset("tbl_ItemCost")
ConnectBILL
rsVendor.MoveFirst
Do Until rsVendor.EOF
strQuery = "SELECT MASID, LOCATION, ITEM, ITEM_QTY, ITEM_UOM, ITEM_COST, EXP_DT " _
& "FROM ITEMMASTER INNER JOIN ORDDETAIL ON (ITEMMASTER.ITEM = ORDDETAIL.ITEM) " _
& "WHERE (LOCATION IN (AS1,AS3,AS6) AND TRIM(MASID) = '" & Cstr(rsVendor.Fields("ORDID")) & "' AND EXP_DT >= #paramDate)"
With ComBill
.CommandText = strQuery
Set rsData = .Execute(, Array(dtDate))
end with
'clears previous instance of vendor data by vendor_no if it exists
db.Execute "DELETE * FROM tbl_ItemCost WHERE MASID LIKE '*" & rsVendor.Fields("ORDID") & "*'"
'starts inserting queried data
rsData.MoveFirst
Do Until rsData.EOF
With rsItemCost
.AddNew
.Fields("MASID") = rsData!MASID
.Fields("LOCATION") = rsData!LOCATION
.Fields("ITEM") = rsData!ITEM
.Fields("ITEM_UOM") = Trim(rsData!ITEM_UOM)
.Fields("ITEM_COST") = rsData!ITEM_COST
.Fields("EXP_DT") = rsData!EXP_DT
.Update
End With
rsData.MoveNext
Loop
rsVendor.MoveNext
Loop
End Sub
Correct these two lines:
dtDate = DateAdd("d", -60, Date)
& "WHERE LOCATION IN (AS1,AS3,AS6) AND TRIM(MASID) = '" & CStr(rsVendor.Fields("ORDID") & "' AND EXP_DT >= #" & Format(dtDate, "yyyy\/mm\/dd") & "#) "
Note, that for ADO, string expressions for date values must be formatted using the ISO sequence.
If the field EXP_DT is Text:
& "WHERE LOCATION IN (AS1,AS3,AS6) AND TRIM(MASID) = '" & CStr(rsVendor.Fields("ORDID") & "' AND EXP_DT >= '" & Format(dtDate, "m\/d\/yyyy") & "') "
The following was written to inform a user if they are entering duplicate information.
It never detects the duplicate, but all else around it works.
The values from debug (for formats etc.) are
me.lisAppID = 1
me.dtReviewDate = 10/09/2015
me.txtReviewerName = colin
This is the query
Dim tmpRS As DAO.Recordset
Set tmpRS = CurrentDb.OpenRecordset("SELECT TblReview.ReviewID FROM TblReview Where (TblReview.AppID = " & Me.lisAppID & ") And (TblReview.RevDateTime)= #" & Me.dtReviewDate _
& "# And (TblReview.RevUserID)= '" & Me.txtReviewerName & "'")
If tmpRS.RecordCount > 0 Then
MsgBox "Record is a duplicate, it will not be saved", vbOKOnly
Cancel = 1
Exit Sub
End If
Set tmpRS = Nothing
Here are some things to try.
Explicitly format your date variable when building the sql string:
Set tmpRS = CurrentDb.OpenRecordset("SELECT TblReview.ReviewID FROM TblReview Where (TblReview.AppID = " & Me.lisAppID _
& ") And (TblReview.RevDateTime)= #" & Format(Me.dtReviewDate,"mm/dd/yyyy") _
& "# And (TblReview.RevUserID)= '" & Me.txtReviewerName & "'")
Consider using the optional parameters in the OpenRecordset method. Some types of connection do not actually return a value for the Recordset.RecordCount property. From MSDN:
The RecordCount property doesn't indicate how many records are contained in a dynaset–, snapshot–, or forward–only–type Recordset object until all records have been accessed.
Dim mydb As DAO.Database
Dim myrst As DAO.Recordset
Dim Date1, Date2 As Date
Dim mysql As String
Dim qdf As QueryDef
Dim EmployeeID As String
EmployeeID = DLookup("lngEmpID", "tblEmployees", "Forms!frmEmployeeOrderForm.cboEmployeeName.Value = EmployeeName")
Me.EmpID = EmployeeID
PickupTime = DLookup("Pickup", "tblEmployees", "Forms!frmEmployeeOrderForm.cboEmployeeName.Value = EmployeeName")
Me.PickupDay = PickupTime
Set mydb = CurrentDb
Date1 = Me.dtmGiveAwayDate1
Date2 = Me.dtmGiveAwayDate2
mysql = ("Select tblOrders.lngEmpID, tblOrders.dtmGiveAwayDate1, tblOrders.dtmGiveAwayDate2 FROM tblOrders WHERE tblOrders.lngEmpID =" & EmployeeID & " AND tblOrders.dtmGiveAwayDate1 =" & Date1 & " AND tblOrders.dtmGiveAwayDate2 =" & Date2)
MsgBox mysql
Set myrst = mydb.OpenRecordset(mysql)
If myrst.EOF = False Then
MsgBox "You have already ordered for this PFG." & vbCrLf & "Please see Jody for help."
cmdCancel_Click
Exit Sub
End If
When I run the program I am trying to prevent employees from entering their name twice for the same dates. To test I tried to duplicate a record for the same employee and it will not trigger the myrst.eof = false and display the message box that says "You have already ordered for this PFG". Any help is much appreciated.
Thank you in advance.
Use the FindFirst method :
myrst.FindFirst "field = " & value
If myrst.NoMatch Then
//code when record doesn't exist
End If
Checking for equality with dates can be tricky. Since VBA dates can include time to the nanosecond, could it be that one side (SQL/code) has a real time, while the other has the default midnight value?
Set mydb = CurrentDb
Date1 = Format(Me.dtmGiveAwayDate1, "Short Date")
Date2 = Format(Me.dtmGiveAwayDate2, "Short Date")
mysql = ("Select tblOrders.lngEmpID, tblOrders.dtmGiveAwayDate1, tblOrders.dtmGiveAwayDate2 FROM tblOrders WHERE tblOrders.lngEmpID =" & EmployeeID & " AND tblOrders.dtmGiveAwayDate1 =" & "#" & Date1 & "#" & " AND tblOrders.dtmGiveAwayDate2 =" & "#" & Date2 & "#")
MsgBox mysql
Set myrst = mydb.OpenRecordset(mysql)
This was the code I used and it works now. Thank you.
I am trying to write an if loop for MS Access VBA
In php I would write:
if($query=="0"){
run query 1
} else {
run query 2
}
I do need to call the query in and refer to multiple tables (ie. 'query 1' will extract data from a combo box, whereas, 'query 2' will run another query)
------------------------------------EDIT: 02/06/14 13:34 AEST ----------------------------
Dim variabl1 As String
variabl1 = Me.cmbItemDetails.Column(1)
Dim variabl2 As String
variabl2 = "" & Forms!frmRaiseOrder!cmbDebtorCode & ""
'you can use variable as a parameter in SQL, but only if you hardcode your SQL statement as a string... See directly below
Dim SQL As String
SQL_count = "SELECT COUNT(CustItemPrice) FROM tblSpecialPricing WHERE ItemListID = '" & variabl1 & "' AND CustListID = '" & variabl2 & "' "
SQL_select = "SELECT CustItemPrice FROM tblSpecialPricing WHERE ItemListID = '" & variabl1 & "' AND CustListID = '" & variabl2 & "' "
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(SQL_count)
If rs.RecordCount = "0" Then
Me.txtStreetPrice.Value = Me.cmbItemDetails.Column(3)
Else
DoCmd.OpenQuery "qrySelectCustomerName"
End If
Thanks to #MurDeR for the assistance for the above statements
----------------------------------------------- Update as of 9th July -----------------------------------
Hi everyone;
If you are trying to create an IF() statement in ACCESS VBA, use the following syntax...
Private Sub cmbItemDetails_Change()
Me.txtItemDescription.Value = Me.cmbItemDetails.Column(2)
Me.txtStreetPrice.Value = Me.cmbItemDetails.Column(3)
Me.txtItemName.Value = Me.cmbItemDetails.Column(1)
Dim variabl1 As String
variabl1 = Me.cmbItemDetails.Column(0)
Dim variabl2 As String
variabl2 = "" & Forms!frmRaiseOrder!cmbDebtorCode & ""
'you can use variable as a parameter in SQL, but only if you hardcode your SQL statement as a string... See directly below
Dim SQL As String
SQL_count = "SELECT COUNT(CustItemPrice) FROM tblSpecialPricing WHERE ItemListID = '" & variabl1 & "' AND CustListID = '" & variabl2 & "' "
SQL_select = "SELECT CustItemPrice FROM tblSpecialPricing WHERE ItemListID = '" & variabl1 & "' AND CustListID = '" & variabl2 & "' "
Dim rs As Recordset
Set rs = Nothing
Set rs = CurrentDb.OpenRecordset(SQL_count)
RecordCount = rs.Fields(0)
If RecordCount = "1" Then
'SPECIAL PRICE EXISTS - this code will run only if the count query is greater than zero
MsgBox "Special Price Exists", vbOkay, "Alert"
'
'
Me.txtUnitPrice.Value = Me.cmbItemDetails.Column(3)
'Me.txtUnitPrice.Value = "" & Forms!frmRaiseOrder!subformCreateOrder!frmSelectCustomPriceinsubform!CustItemPrice & ""
'Me.txtUnitPrice.Value = Me.subfrmItemPrice.CustItemPrice.Value
Else
'NO SPECIAL PRICE - this code will run only if the coutn query is zero
'MsgBox "No Special Pricing for this item", vbOkay, "Alert"
'
'
Me.txtUnitPrice.Value = Me.cmbItemDetails.Column(3)
End If
End Sub
I would really like to thank and credit #MurDeR for their help and also if you have any questions, PM me or post here
You can work with a recordset in VBA.
See this bit of code for a start.
Dim variabl As String
variabl = Me.ComboBox1.Value
'you can use variabl as a parameter in SQL, but only if you hardcode your SQL statement as a string... See directly below
Dim SQL As String
SQL = "SELECT * FROM TableA WHERE YourColumnName = '" & variabl & "'"
Dim db As DAO.Database
db = CurrentDb
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("SQL Statement or Query Name")
If rs.RecordCount = 0 Then
DoCmd.OpenQuery "Query1"
Else
DoCmd.OpenQuery "Query2"
End If
rs.Close
Set rs = Nothing
Let me know if you have any other questions. Also note, you need to make sure you're entering proper query names. I know VBA has pathetic intellisense, so this can be tricky when entering query names as strings.
I have got a workbook containing several worksheets.
Parameters are entered on one sheet, and I am on the way to creating a macro which takes these parameters, adds them to the connection string and then updates each table on each sheet.
I have got it working for one connection, but I am struggling to find a way of storing each connection name and then and looping through each connection adding the variables.
Here is the code I have so far, some of it is commented out..which is how I managed to solve the problem for one connection. Any guidance would be very much appreciated.
Sub Update()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Parameters")
Dim startdate As Date
Dim enddate As Date
startdate = Range("week_start_date").Value
enddate = Range("week_end_date").Value
MsgBox "Values are " & startdate & " and " & enddate
Dim nm As ActiveWorkbook.Connections.name
Dim conn As WorkbookConnection
For Each conn In ActiveWorkbook.Connections
.CommandText = "exec dbo.'" & name & "', #start = '" & startdate & "', #end = '" & enddate & "' "
'With ActiveWorkbook.Connections("ps_STS_Op_Summary_Approvals").OLEDBConnection
'.CommandText = "exec dbo.ps_STS_Op_Summary_Approvals #start = '" & startdate & "', #end = '" & enddate & "'"
End With
'ActiveWorkbook.Connections("ps_STS_Op_Summary_Approvals").Refresh
For Each wSht In ThisWorkbook.Worksheets
For Each qt In wSht.QueryTables
qt.Refresh
Next
Next
End Sub
Find the number of connections stored in the workbook and then loop through them using the .item(x) property of ActiveWorkbook.Connections:
cnt = ActiveWorkbook.Connections.Count
For i = cnt To 1 Step -1
Set conn = ActiveWorkbook.Connections.Item(i)
'Do stuff to conn
Next i
Also refer to this question on stack overflow