I have a VBA code that checks if there are data in a year and month the user inputs, and by that it decides to which query to send the user.
this is the code:
Sub macro1()
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim qdf2 As DAO.QueryDef
Dim year As Integer
Dim month As Integer
Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("äëðñåú äåöàåú")
Set qdf2 = dbs.QueryDefs("äëðñåú äåöàåú àí àéï èåøðéø áçåãù")
year = InputBox("What year would you want to get data from?")
month = InputBox("What month would you want to get data from")
If Not IsNull(DLookup("[÷åã èåøðéø]", "[àãîéðñèøöéä ùì úçøåéåú]", "DateDiff('m', [úàøéê çæøä îäèåøðéø], DateSerial(" & year & ", " & month & ", 1)) = 0")) Then
qdf.Parameters("[äëðñ ùðä]") = year
qdf.Parameters("[äëðñ çåãù]") = month
DoCmd.OpenQuery "äëðñåú äåöàåú", acViewNormal, acReadOnly
Else
qdf2.Parameters("äëðñ ùðä") = year
qdf2.Parameters("äëðñ çåãù") = month DoCmd.OpenQuery "äëðñåú äåöàåú àí àéï èåøðéø áçåãù", acViewNormal, acReadOnly
End If
End Sub
The code works perfectly except that it doesn't input the year and month for the query, which means the user needs to enter the data twice, and he can enter different data on the second time, which doesn't solve the porblem.
I think the main reason is that both querys are built from other querys (because there relationship is to complicated to do on 1 query)
The qdf.Parameters collection only works when invoking the query using qdf.Execute.
If you're using DoCmd.OpenQuery, you should set parameters using DoCmd.SetParameter. Note that they need to be set again after invoking the first DoCmd.OpenQuery:
DoCmd.SetParameter "[äëðñ ùðä]", year
DoCmd.SetParameter "[äëðñ çåãù]", month
DoCmd.OpenQuery "äëðñåú äåöàåú", acViewNormal, acReadOnly
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've been asked to make a change to a VB6 project. The issue I'm having is that I'm trying to get some data from an Access database and assign the data to some variables.
I've got the code:
Dta_Period.DatabaseName = DB_Accounts_Name$
Dta_Period.RecordSet = "SELECT * FROM [Period]"
Dta_Period.Refresh
The table Period contains 2 fields. sMonth and Period
The sMonth field contains the months January - December. The Period field stores a number 0 to 11, to represent what number has been assigned to which month in the customers financial year. January may be 0, or may be 11, essentially.
I need to know which month goes with which period, which is why I have selected this data from the database. However, I'm stuck with what to do next.
How can I loop over the RecordSet (If this is even possible?) and find out what number has been assigned to each month?
I don't think there is a way I can use a Do Until loop. Is it easier to just use 12 separate queries, and then create an array of strings and an array of integers and then loop over the array of strings until I find the correct month, the use the same index for the array on integers?
EDIT 1
To make things simpler to follow for both myself and anyone attempting to provide an answer, I have modified the code.
Dim rstPeriod As DAO.RecordSet
Dim accDB As DAO.Database
' DB_Session is a Workspace, whilst DB_Accounts_Name$ is the name of the DB I am using
Set accDB = DB_Session.OpenDatabase(DB_Accounts_Name$)
SQL = "SELECT * FROM [Period] ORDER BY [Period]"
Set rstPeriod = accDB.OpenRecordset(SQL, dbOpenDynaset)
If rstPeriod.BOF = False Then
rstPeriod.MoveFirst
End If
Dim strMonth(11) As String
Dim pNumber(11) As Integer
Pseudocode idea:
Do Until rstPeriod.EOF
Select Case currentRow.Field("Month")
Case "January"
strMonth(0) = "January"
pNumber(0) = currentRow.Field("Number")
Case "February"
strMonth(1) = "February"
pNumber(1) = currentRow.Field("Number")
End Select
Loop
Loop through recordset and fill the arrays with the month name and month number.
This assumes the recordset returns no more than 12 records.
Public Sub LoopThroughtRecordset()
On Error GoTo ErrorTrap
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT * FROM [Period] ORDER BY [Period]", dbOpenSnapShot)
With rs
If .EOF Then GoTo Leave
.MoveLast
.MoveFirst
End With
Dim strMonth(11) As String
Dim pNumber(11) As Integer
Dim idx As Long
For idx = 0 To rs.RecordCount -1
strMonth(idx) = rs![Month]
pNumber(idx) = rs![Number]
rs.MoveNext
Next idx
Leave:
On Error Resume Next
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ErrorTrap:
MsgBox Err.Description, vbCritical, CurrentDb.Properties("AppTitle")
Resume Leave
End Sub
'strMonth(0) = January
'strMonth(1) = February
'...
'pNumber(0) = 1
'pNumber(1) = 2
'...
I created a query separately and now want to use VBA to read its records and then send certain fields of all rows in an email.
I am currently stuck on trying to extract all the rows from the recordset. I know how to do it for one record, but not with a dynamic recordset. Every week, the recordset could potentially have 1-10 (approx.) records. I had hoped to do this by dynamically reading all rows, saving the fields that I want into variables, and then adding that to the email body, but I arrived at an error.
I'm getting an error that says: Run-time error '3265': Item not found in this collection.
Does anyone know how to fix this error and how I can put all resulting rows of the recordset into the email body?
The code:
Private Sub Form_Timer()
'current_date variable instantiated in a module elsewhere
current_date = Date
'Using the Date function to run every Monday, regardless of the time of day
If current_date = (Date - (DatePart("w", Date, 2, 1) - 1)) Then
'MsgBox ("the current_date variable holds: " & current_date)
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim varRecords As Variant
Dim intNumReturned As Integer
Dim intNumColumns As Integer
Dim intColumn As Integer
Dim intRow As Integer
Dim strSQL As String
Dim rst_jobnumber As String
Dim rst_bfloc As String
Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("qry_BMBFLoc")
Set rst = qdf.OpenRecordset
If rst.EOF Then
MsgBox "Null."
Else
'Found this part of the code online and not sure if I'm using it right.
varRecords = rst!GetRows(3)
intNumReturned = UBound(varRecords, 2) + 1
intNumColumns = UBound(varRecords, 1) + 1
For intRow = 0 To intNumReturned - 1
For intColumn = 0 To intNumColumns - 1
Debug.Print varRecords(intColumn, intRow)
Next intColumn
Next intRow
'End of code found online.
'rst.MoveFirst 'commenting this out because this query could potentially return multiple rows
rst_jobnumber = rst!job & "-" & rst!suffix
rst_bfloc = rst!Uf_BackflushLoc
rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing
'Dim oApp As Outlook.Application
'Dim oMail As MailItem
'Set oApp = CreateObject("Outlook.application")
'mail_body = "The following jobs do not have the special BF location set in Job Orders: " & rst_
'Set oMail = oApp.CreateItem(olMailItem)
'oMail.Body = mail_body
'oMail.Subject = "Blow Molding Jobs Missing BF Location"
'oMail.To = "something#something.com" 'in the future, create a function that finds all of the SC users' emails from their Windows user
'oMail.Send
'Set oMail = Nothing
'Set oApp = Nothing
End If
End If
ErrorHandler:
MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Sub
Try working with this code and see how it works for you. I was unsure if you were sending one email per or one email listing all (I assumed the latter)
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strMessageBody As String
Set dbs = CurrentDb
Set rst = CurrentDb.OpenRecordset("qry_BMBFLoc")
strMessageBody = "The following jobs do not have the special BF location set in Job Orders: "
If Not (rst.EOF And rst.BOF) Then
rst.MoveFirst
Do Until rst.EOF = True
strMessageBody = strMessageBody & rst!job & "-" & rst!suffix & ","
rst.MoveNext
Loop
If Right(strMessageBody, 1) = "," Then strMessageBody = Left(strMessageBody, Len(strMessageBody)-1)
End If
rst.Close
Set rst = Nothing
Set dbs = Nothing
EDIT - not using dot operator
Replace
varRecords = rst!GetRows(3)
with
varRecords = rst.GetRows(3)
Do you have three rows in your recordset?
If not rst!GetRows(3) will return false - and then next line will fail when you try to use UBound.
A good example of how to implement GetRows
Another possibility is if you're trying to access a Field that's not in your recordset on a line that has rst!
I am combining multiple Excel Worksheets into one SharePoint list so our data is all in one place and modifiable by multiple users at once. The Append query worked without a hitch.
Now I am trying to update one filed in the list with an update query but it keeps locking up MS Access (Not Responding, 100% CPU usage). I have to terminate from the task manager.
I have let it run for as much as 10 minutes. So then I switched to the one time use sub procedure below to update through a recordset. Same issue.
I am able to update the field manually one at a time via the linked list in MS Access. I can update the field via datasheet and dialog in SharePoint.
SharePoint 2010
MS Access 2013
Does anyone have any ideas?
Option Compare Database
Option Explicit
Public Sub UpdateDataPlateDates()
On Error GoTo err_trap
Dim db As DAO.Database: Set db = CurrentDb()
Dim rst As DAO.Recordset
Dim strSQL As String
Dim i As Integer: i = 1
Dim vDate As Variant
Dim sNum As String
strSQL = "SELECT TML.[SERIAL NUMBER], TML.[DATA PLATE DATE] FROM [Tool Master List] AS TML WHERE (((TML.[DATA PLATE DATE]) Is Null));"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
With rst
If Not (.BOF And .EOF) Then
.MoveLast: .MoveFirst
Do Until .EOF
sNum = ![SERIAL NUMBER].Value
vDate = DLookup("[ACCEPT DATE]", "Tool information", "[SERIAL NUMBER]='" & sNum & "'")
Debug.Print i, sNum, vDate
If Not (IsNull(vDate) Or IsEmpty(vDate)) Then
vDate = CDate(vDate)
.Edit
![DATA Plate Date] = vDate '//FAILS-LOCKS UP RIGHT HERE WITHOUT and ERROR
.Update
End If
.MoveNext
i = i + 1
sNum = vbNullString
vDate = Null
DoEvents
Loop
End If
.Close
End With
Set rst = Nothing
Set db = Nothing
exit_sub:
Exit Sub
err_trap:
Debug.Print Err.Number, Err.Description
Stop
Resume
End Sub
Is it possible the item you are trying to update is being edited by a user? Have you considered linking the SharePoint table and performing an update query instead?
I'm trying to make a Microsoft Access query depend on a value in another form's textbox.
This is the criteria, as it is now. Basically, any date between April 1st 2014, and March 31st 2015. This works well.
>=#2014-04-01# And <#2015-04-01#
I'd like to have a textbox with the year (with the current example 2014), and make the query criteria (2014, 2014+1) depend on this value.
I've tried to split the above syntax, then concatenate in the criteria, as such:
">=#" & "2014" & "-04-01# And <#" & "2015" & "-04-01#"
And I get an error "Data types in the criterion expression are incompatible".
1. Is it possible to concatenate in the query criteria?
I have also tried the SQL CONCAT(string1,string2,string3,..), to no avail.
If this is possible, then I guess I can use [Forms]![Form1].[Textbox1] and ([Forms]![Form1].[Textbox1] + 1) to replace the years.
If this is not possible...
2. Is there a better way to make the query criteria dynamic?
I tried to make the following solution work by creating a module with similar code:
Private m_varQueryParam As Variant
Public Function SetQueryParam(ByVal sValue as Variant)
m_varQueryParam = sValue
End Function
Public Function GetQueryParam() As Variant
GetQueryParam = m_varQueryParam
End Function
Query:
SELECT * FROM tblYourTable WHERE [FilterField] = GetQueryParam()
The VBA Code to launch the query will look like this.
SetQueryParam "your value here"
DoCmd.OpenQuery "qryYourQueryHere"
But I simply do not understand how to get this to work.
EDIT: I created a simple access database, to try to get this to work.
Textbox1, default value =Date()
bSave, button
tDateInfo, table: date (date/time), info (text) with random dates and info.
Query1:
SELECT tDateInfo.date, tDateInfo.info
FROM tDateInfo
WHERE (((tDateInfo.date)=GetQueryParam()));
Here's the form's vba code
Option Compare Database
Private Sub bSave_Click()
sValue = Me.TextBox1.Value
SetQueryParam (sValue)
End Sub
Here's the modules vba code
Option Compare Database
Option Explicit
'is this necessary?
Private m_varQueryParam As Variant
Public Function SetQueryParam(ByVal sValue As Variant)
m_varQueryParam = sValue
End Function
Public Function GetQueryParam() As Variant
GetQueryParam = m_varQueryParam
End Function
And the query criteria is GetQueryParam()
Thank you for your help.
Handling parameters and form fields is a little tricky with VBA. I created a simple table similar to yours as follows:
CREATE TABLE DateCalc (
ID AutoNumber,
FilterField DateTime
)
The following code will return your desired results:
Sub testthis()
Dim db As dao.database
Set db = CurrentDb ' use current database
Dim qd As dao.QueryDef
Set qd = db.CreateQueryDef("") ' create anaonymous querydef
' the SQL statement correctly concatenates the parameter (Useyear) and mm/dd strings
qd.sql = "SELECT * FROM DateCalc WHERE [FilterField] >= [UseYear]" & "-04-01 And [FilterField] < [UseYear]+1" & "-04-01"
qd!UseYear = Forms!DateCalc!txtYear ' set the value of se year from the Form WHICH MUST BE OPEN
' AND the TetBox filled with the year you desire - 2014 for this example.
Dim rs As dao.recordSet
Set rs = qd.OpenRecordset
MsgBox "ID=" & rs(0) & ", Date=" & rs(1)
End Sub
NEW VERSION
Sorry, there were a couple of date formatting problems with the first solution that the following code resolves. There are a number of other reasons for the error, so be sure the FormName is "DateCalc" and the TextBox is named "txtYear".
You should be able to generalize the following code for all your queries (do those actually work?). I pass the TableName in now as an example:
Sub DateFilter(TableName As String)
Dim db As dao.database
Set db = CurrentDb ' use current database
Dim qd As dao.QueryDef
Set qd = db.CreateQueryDef("") ' create anaonymous querydef
' the SQL statement correctly concatenates the parameter (Useyear) and mm/dd strings
Dim UseYear As Integer
UseYear = Forms!DateCalc!txtYear
Dim BegDate As Date
BegDate = CDate(UseYear & "-04-01")
Dim EndDate As Date
EndDate = CDate((UseYear + 1) & "-04-01")
qd.sql = "SELECT * FROM " & TableName & " WHERE [FilterField] >= [UseBegDate] And [FilterField] < [UseEndDate]"
qd!UseBegDate = BegDate
qd!UseEndDate = EndDate
Dim rs As dao.recordSet
Set rs = qd.OpenRecordset
Do While Not rs.EOF
MsgBox "ID=" & rs(0) & ", Date=" & rs(1)
rs.MoveNext
Loop
End Sub
I think I found a solution.
The following code defines the SQL as I require it, and changes the SQL for the Access query.
It's not ideal, because it requires me to rewrite all the SQL for the queries, but it works.
Sub ChangeQuery()
Dim Year, sqlTwo, StartDate, EndDate As String
Year = Me.txtYear.Value
StartDate = "4/1/" & Year
EndDate = "4/1/" & (Year + 1)
sqlTwo = "SELECT DateCalc.ID, DateCalc.FilterField FROM DateCalc WHERE (((DateCalc.FilterField)>=#" & StartDate & "# And DateCalc.FilterField<#" & EndDate & "#));"
tbTest.Value = sqlTwo
Dim oDB As Database
Dim oQuery As QueryDef
Set oDB = CurrentDb
Set oQuery = oDB.QueryDefs("Query1")
oQuery.SQL = sqlTwo
Set oQuery = Nothing
Set oDB = Nothing
End Sub
Private Sub Button_Click()
ChangeQuery
End Sub