When there is only one record, this expression gives correct calculation, but when there are more than one record the values of last record calculated is reflected in all Total_Time (unbound text box).I have given on load and on open code of the report. Please help me.
Private Sub Report_Load()
strSQL = "SELECT * FROM [q_1ltduty]"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
rs.MoveFirst
Do While Not rs.EOF
'Assigning values of fields to varia
strtime1 = Op_Time
strtime2 = Cl_Time
'This is a simple expression my code has some more detailed calculations
strhrs = strtime2 - strtime1
strtotalhrs = strhrs
'Printing the variable in Total_Time textbox(unbound)
Me.Total_Time.Value = strtotalhrs
rs.MoveNext
Loop
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
End Sub
Private Sub Report_Open(Cancel As Integer)
strSQL = "SELECT * FROM [q_1ltduty]"
Me.RecordSource = strSQL
Debug.Print strSQL
Exit Sub
ErrHandler:
MsgBox Err.Description
End Sub
Your variable strtotalhrs contains only the value of strhrs for one record, so each time you go through the loop, the value for the current record erases the value for the previous record. What you should do instead of erasing the value is adding to it.
Before the loop (if it has not already been done):
strtotalhrs = 0
then in the loop, instead of strtotalhrs = strhrs:
strtotalhrs = strtotalhrs + strhrs
and that should give you the sum total instead of the last value.
Related
I have a access table that I am doing a search by date range on. In the form I have a text box TxtTotal that I want to display the number of records in the filtered range the code I have. keeps giving me the complete number of records and not the range filtered.
This is my module
Function FindRecordCount(strSQL As String) As Long
Dim db As Database
Dim rstRecords As Recordset
'On error GoTo ErrorHandler
Set db = CurrentDb
Set rstRecords = db.OpenRecordset("TblPurchases")
If rstRecords.EOF Then
FindRecordCount = 0
Else
rstRecords.MoveLast
FindRecordCount = rstRecords.RecordCount
End If
rstRecords.Close
db.Close
Set rstRecords = Nothing
Set db = Nothing
End Function
This is my code for the TxtTotal text box on the form
Sub Search()
Dim strCriteria, task As String
Me.Refresh
If IsNull(Me.TxtPurchaseDateFrom) Or IsNull(Me.TxtPurchaseDateTo)
Then
MsgBox "Please enter the date range", vbInformation, "Date Range
Required"
Me.TxtPurchaseDateFrom.SetFocus
Else
strCriteria = "([Date of Purchase] >= #" & Me.TxtPurchaseDateFrom &
"# and [Date of Purchase] <= #" & Me.TxtPurchaseDateTo & "#)"
task = "select * from TblPurchases where( " & strCriteria & ") order
by [Date of Purchase] "
DoCmd.ApplyFilter task
Me.TxtTotal = FindRecordCount(task)
End If
End Sub
the results keeps giving me the complete number of records and not the range filtered.
I believe the main issue is this line:
Set rstRecords = db.OpenRecordset("TblPurchases")
You are setting the Record set to use the table as its source instead of your SQL string. No matter what your input dates are, if you are looking at the whole table, it will return the whole table xD.
As for finding the total count of items from a query result, it might make sense to use the SQL COUNT function eg: SELECT COUNT(<Column>) FROM <table> WHERE <criteria>; This will provide you the number of data entries that are provided from that query.
I would also recommend using the QueryDef Object for your SQL definitions since it makes things a little cleaner. But again, this is just a recommendation EG:
Function FindRecordCount(dateFrom As Date, dateTo As Date) As Long
Dim db As DAO.Database
Dim QDF As DAO.QueryDef
Dim rstRecords As DAO.Recordset
Dim SQL As String
SQL = "SELECT COUNT(*) FROM TblPurchase WHERE([Date of Purchase] >= ##dateFrom# AND [Date of Purchase] <= ##dateTo#)"
Set db = CurrentDb
Set QDF = db.QuerDefs(SQL)
QDF.Paramaters("#dateFrom").Value = dateFrom
QDF.Paramaters("#dateTo").Value = dateTo
Set rstRecords = QDF.OpenRecordset("TblPurchases")
If rstRecords.EOF Then
FindRecordCount = 0
Else
rstRecords.MoveLast
FindRecordCount = rstRecords.RecordCount
End If
rstRecords.Close
QDF.Close
db.Close
Set rstRecords = Nothing
Set QDF = Nothing
Set db = Nothing
End Function
Best Regards.
You could replace all this with a DCount expression in the ControlSource of the textbox txtTotal:
=DCount("*","TblPurchase ","[Date of Purchase] Between #" & Format(Nz(Me!TxtPurchaseDateFrom.Value,Date()), "yyyy\/mm\/dd") & "# And #" & Format(Nz(Me!TxtPurchaseDateTo.Value,Date()), "yyyy\/mm\/dd") & "#")
I have been looking for some code that creates a calendar year and will take data from a table and place it in the corresponding date on the calendar. I found some code online (from an older version of access) that pretty much fit the bill, with some modifications it does exactly what I need it to do. Originally, the code pulled data from one table and it was set up to run on the current year. I use two queries, qr_SafetyCal and qr_SafetyCal2, to refine data from the one table. The first query prioritizes the data and eliminates multiple events on any given day. The second query uses the results from the first and specifies the year in the query criteria.
The code works flawlessly as long as I set the year criteria in the qr_SafetyCal2 and specify the first day, ex. 1/1/2017 (datStart) in the underlying code of the calendar year I want displayed.
After getting the code squared away I created a pop up form the user to select the year for the report but when I run the report I get the following error, Runtime Error 3061 too few parameters expected 1.
From what I have been able to research, I believe I changed the dynamic of the code when I referenced the form in the query criteria that the DAO Recordset Used.
As I understand it, the criteria in the query is not passed to the rs and therefore needs to be declared in the code. What I can't figure out is how to declare the variables in the code through reference to the form. I hope that makes some sense to somebody, long explanation but hard to describe something you don't understand.
Below is all the code and you will see some things I've rem'd out that I have tried but did not work. Any help would be greatly appreciated. I apologize ahead of time if the code is not formatted correctly.
Option Compare Database
Option Explicit
Private m_strCTLLabel As String
Private m_strCTLLabelHeader As String
Private colCalendarDates As Collection
Function getCalendarData() As Boolean
Dim rs As DAO.Recordset
Dim strDate As String
Dim strCode As String
Dim i As Integer
'Dim qdf As DAO.QueryDef
'Set qdf = CurrentDb.QueryDef("qr_SafetyCal2")
'qdf.Parameters("[Forms]![fr_SafetyCal]![cboYear]") = [Forms]![fr_SafetyCal]![cboYear]
'Set rs = qdf.OpenRecordset("qr_SafetyCal2", dbOpenDynaset)
Set rs = CurrentDb.OpenRecordset("qr_SafetyCal2", dbOpenDynaset)
Set colCalendarDates = New Collection
With rs
If (Not .BOF) Or (Not .EOF) Then
.MoveLast
.MoveFirst
End If
If .RecordCount > 0 Then
For i = 1 To .RecordCount
strDate = .Fields("Date")
strCode = .Fields("ShortName")
colCalendarDates.Add strCode, strDate
.MoveNext
Next i
End If
.Close
End With
'Return of dates and data collection form qr_SafetyCal2
Set rs = Nothing
End Function
Public Sub loadReportYearCalendar(theReport As Report)
Dim i As Integer
Dim datStart As Date
Dim rptControl As Report
m_strCTLLabel = "labelCELL"
m_strCTLLabelHeader = "labelDAY"
'Load calendar data for the specified year into the collection
Call getCalendarData
With theReport
'Get the first month of the specified year
datStart = "1/1/2017" '"1/1/" & Year(Date), "1/1/" & Forms!
[fr_SafetyCal]![cboYear], Forms![fr_SafetyCal]![txtCalYear]
'Add the specified year to the report's label
.Controls("labelCalendarHeaderLine2").Caption = Year(datStart) & "
iCalendar"
For i = 1 To 12
'Set pointer to subreport control hosting the mini-calendar
Set rptControl = .Controls("childCalendarMonth" & i).Report
'Run procedure to populate control with it's respective year
Call loadReportCalendar(rptControl, datStart)
'Reset and obtain first day of the following month
datStart = DateAdd("m", 1, datStart)
Next i
End With
'Clean up
Set colCalendarDates = Nothing
Set rptControl = Nothing
End Sub
Public Sub loadReportCalendar(theReport As Report, Optional StartDate As
Date, Optional theHeaderColor As Variant)
Dim i As Integer
Dim intCalDay As Integer
Dim datStartDate As Date
Dim intWeekDay As Integer
datStartDate = StartDate
intWeekDay = Weekday(datStartDate)
With theReport
.Controls("labelMONTH").Caption = Format(StartDate, "mmmm")
'Change the day label's backcolor if necessary
If Not (IsMissing(theHeaderColor)) Then
For i = 1 To 7
.Controls("labelDayHeader" & i).BackColor = theHeaderColor
Next
End If
For i = 1 To 42
With .Controls(m_strCTLLabel & i)
If (i >= intWeekDay) And (Month(StartDate) =
Month(datStartDate)) Then
If (datStartDate = Date) Then
.BackColor = 14277081
End If
On Error Resume Next
Dim strCaption As String
Dim strKey As String
strKey = datStartDate
strCaption = ""
strCaption = colCalendarDates.Item(strKey)
colCalendarDates.Remove strKey
'Set back color to grean on days in the past that have
no corresponding event
If (datStartDate < Date) And (strCaption = vbNullString) Then
.Caption = Day(datStartDate)
.Bold = False
.BackColor = vbGreen
.ForeColor = vbWhite
.Heavy = True
'Do not set a back color for days in the future
ElseIf (datStartDate > Date) And (strCaption = vbNullString) Then
.Caption = Day(datStartDate)
.Bold = False
'Set the corresponding labels and formats for each specified event
Else
.Caption = strCaption
.Bold = True
Select Case strCaption
Case "FA"
.BackColor = vbYellow
.ForeColor = 0
.LeftMargin = 0
.TextAlign = 2
Case "FAM"
.BackColor = vbYellow
.ForeColor = 0
.LeftMargin = 0
.TextAlign = 2
.Heavy = True
Case "LTA"
.BackColor = vbRed
.ForeColor = vbWhite
.LeftMargin = 0
.TextAlign = 2
Case "MED"
.BackColor = vbRed
.ForeColor = vbWhite
.LeftMargin = 0
.TextAlign = 2
End Select
End If
datStartDate = DateAdd("d", 1, datStartDate)
Else
.Caption = ""
End If
End With
Next i
End With
End Sub
Here is SQL for the two queries, the first is qr_SafetyCal and the second is qr_SafetyCal2:
SELECT tb_CaseLog.Date, Max(tb_Treatment.Priority) AS MaxOfPriority,
Count(tb_Treatment.TreatmentID) AS CountOfTreatmentID
FROM tb_Treatment INNER JOIN tb_CaseLog ON tb_Treatment.TreatmentID =
tb_CaseLog.Treatment
GROUP BY tb_CaseLog.Date;
SELECT qr_SafetyCal.Date, tb_Treatment.ShortName,
qr_SafetyCal.CountOfTreatmentID AS [Count], Year([Date]) AS CalYear
FROM qr_SafetyCal INNER JOIN tb_Treatment ON qr_SafetyCal.MaxOfPriority =
tb_Treatment.Priority;
No need to reference QueryDef.
Open the recordset object with filtered dataset by referencing the combobox like:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE CalYear=" & [Forms]![fr_SafetyCal]![cboYear], dbOpenDynaset)
or if the code is behind the form:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE CalYear=" & Me.[cboYear], dbOpenDynaset)
Both examples assume the field is a number type.
If there is no field in query with the year value, it can be extracted from date value field in the VBA construct:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE Year([YourFieldnameHere])=" & [Forms]![fr_SafetyCal]![cboYear], dbOpenDynaset)
Code for setting datStart variable:
'Get the first month of the specified year
datStart = "1/1/" & Forms![fr_SafetyCal].[cboYear]
Ok I am trying to dynamically get recordCount and pass that to .GetRows but it doesnt work as it only pulls in one records into the array. If I just statically put a number into the .GetRows method it works fine, but this is obviously not ideal.
This Works
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Client", dbOpenDynaset, dbSeeChanges)
aRR = rs.GetRows("random number")
For i = 0 To rs.RecordCount - 1
For j = 0 To rs.Fields.Count - 1
Debug.Print ; aRR(j, i)
Next j
Next i
This does not
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Client", dbOpenDynaset, dbSeeChanges)
With rs
rs.MoveLast
Debug.Print ; rs.RecordCount
Q = rs.RecordCount
aRR = rs.GetRows(Q)
End With
For i = 0 To rs.RecordCount - 1
For j = 0 To rs.Fields.Count - 1
Debug.Print ; aRR(j, i)
Next j
Next i
I have tried multiple things I have found on the web but clearly I must be missing something? Is there an easy approach to this or do i need to requery with a DISTINCT clase, and pass the return value within that record set to a new variable?
GetRows also uses the recordset's pointer. With rs.MoveLast you put that pointer to the last row. That's why only one row gets returned. Addrs.MoveFirst after setting Q to resolve this.
Like Phesago mentioned, Access will only return the recordcount based on which record in the recordset it's looking at. As a general practice when working with recordsets, I always begin with the following template:
Private Sub CreateRecordset()
Dim rs As Recordset
Dim sql As String
sql = "SELCT * FROM tblSomeTable"
Set rs = CurrentDb.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges)
With rs
If Not .EOF And Not .BOF Then
.MoveLast
.MoveFirst
Dim i As Integer
For i = 0 To rs.RecordCount - 1
'do whatever actions desired
Next
End If
End With
End Sub
Sincerely in the dark. My Code:
Public Property Get rowCount() As Integer
rowCount = Counter
End Property
Public Property Let rowCount(ByRef inte As Integer)
Counter = inte
End Property
Private Sub Form_Timer() 'Timer
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim Caption As Field, Form As Field, Count As Integer, holder As Integer, item As String
Dim strForms() As String
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("MainMenu", dbOpenDynaset)
ReDim strForms(1 To rs.RecordCount())
If rs.RecordCount <> 0 Then
For c = 1 To rs.RecordCount() Step 1 '!!!THIS IS THE PROBLEM!!!
MsgBox CStr(c)
MsgBox rs("Caption")
strForms(c) = rs("Caption")
rs.MoveNext
MsgBox rs("Caption")
Next c
End If
rowCount = 1
holder = rowCount()
If holder <= rs.RecordCount() Then
Me.Command10.Caption = strForms(holder)
rowCount = holder + 1
Else
rowCount = 1
Me.Command10.Caption = strForms(holder)
End If
End Sub
I added all those message boxes in my effort to debug. All I need is that counter to go up. No idea why it is not. Why will this thing not increment?!
The best way is to use rs.MoveFirst, rs.MoveNext and rs.EOF to check for end of records. The following VBA will do what you want.
'Open up a recordset on our table
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("MyTable", dbOpenDynaset)
'Did we find any records?
If rs.RecordCount > 0 Then
'Move to first record
rs.MoveFirst
'Iterate through each record
Do
'Do stuff with the currentrecord
MsgBox ("Next record ID is: " + CStr(rs("ID")))
'Move to next record
rs.MoveNext
'Exit when we hit the end of the recordset
Loop While rs.EOF <> True
End If
'Close the recordset
rs.Close
Using the RecordCount property might be the problem.
It essesntially just counts the number of times rs.MoveNext had been called.
Try switching the code to a loop like this:
Dim L As Long
Do Until rs.EOF
L = L + 1
MsgBox rs.RecordCount
MsgBox L
rs.MoveNext
Loop
Access Recordsets aren't as easy as .NET DataTables but they've been around a lot longer.
http://msdn.microsoft.com/en-us/library/office/bb208624(v=office.12).aspx
Using VBA, how can I search for a text string, for example "CHIR", in a table called "ServiceYES", in the field "Service".
After that, I would like to save the neighboring field for all the rows that "CHIR" exists in the table "ServicesYES". The "ServiceYES" table is below:
I basically, want to find all the "CHIR" in "Service" column and then save the names which are on the left of the CHIR, eg "FRANKL_L", "SANTIA_D" as an array.
Thanks for all your help in advance.
Start by creating a SELECT query.
SELECT Code_Perso
FROM ServicesYES
WHERE Service = 'CHIR';
Use SELECT DISTINCT Code_Perso if you want only the unique values.
Add ORDER BY Code_Perso if you care to have them sorted alphabetically.
Once you have a satisfactory query, open a DAO recordset based on that query, and loop through the Code_Perso values it returns.
You don't need to load them directly into your final array. It might be easier to add them to a comma-separated string. Afterward you can use the Split() function (assuming you have Access version >= 2000) to create your array.
Here's sample code to get you started. It's mostly standard boiler-plate, but it might actually work ... once you give it "yourquery".
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strItems As String
Dim varItems As Variant
Set db = CurrentDb
Set rs = db.OpenRecordset("yourquery", dbOpenSnapshot)
With rs
Do While Not .EOF
strItems = strItems & "," & !Code_Perso
.MoveNext
Loop
.Close
End With
If Len(strItems) > 0 Then
' discard leading comma '
strItems = Mid(strItems, 2)
varItems = Split(strItems, ",")
Else
MsgBox "Oops. No matching rows found."
End If
Set rs = Nothing
Set db = Nothing
I tested this and it seems to work. This function will pull all records where ServiceYes='CHIR' and dump the Code_Person value into an array which it will return:
Function x() As String()
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset( _
"Select * from ServiceYES where Service='CHIR'")
Dim Arr() As String
Dim i As Integer
While rst.EOF = False
ReDim Preserve Arr(i)
Arr(i) = rst.Fields("Code_Person")
i = i + 1
rst.MoveNext
Wend
x = Arr
End Function
Sample Usage:
Debug.Print x()(0)
Paolo,
Here is something I threw together in a few minutes. You can add it to the VBA editor in a module. It uses a trick to get the RecordCount property to behave properly. As for returing the array, you can update the function and create a calling routine. If you need that bit of code, just post a comment.
Thanks!
Option Compare Database
Function QueryServiceYES()
Dim db As Database
Dim saveItems() As String
Set db = CurrentDb
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("SELECT Code_Perso, Service, Favorites " & _
"FROM ServiceYES " & _
"WHERE Service = 'CHIR'")
'bug in recordset, MoveFirst, then MoveLast forces correct invalid "RecordCount"
rs.MoveLast
rs.MoveFirst
ReDim Preserve saveItems(rs.RecordCount) As String
For i = 0 To rs.RecordCount - 1
saveItems(i) = rs.Fields("Code_Perso")
rs.MoveNext
Next i
'print them out
For i = 0 To UBound(saveItems) - 1
Debug.Print saveItems(i)
Next i
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Function