I am using ACCESS 2007.
I have a table containing items with a start date and an end date.
In a query I try to calculate the number of months that the items from the table are within the period that is requested by the query.
Example: when I run my query it will pop up two dialog boxes, one asking for [Yr] and one for [Mth]. So when [Yr] = 2011 and [Mth]= 5 I trie to find from each item in the table how many months fall between Jan 1, 2011 and May 31, 2011.
Since the calculation of the number of months that fall within the required period takes several IFF statements, I tried to create a VBA function. After several hours of inquiry on the internet my table, query and function look like:
The table:
ID 'unique identifier
Anr 'code
Bdate 'begin date
Edate 'end date
The query (called qryB)
SELECT tblB.ID, tblB.Anr, tblB.BDate, tblB.EDate, NrMth("qryB",[BDate],[EDate],[Yr],[Mth]) AS NrMonths
FROM tblB
ORDER BY tblB.Anr;
The function
Public Function NrMth(qryName As String, BDate As Date, EDate As Date, Yr, Mth) As Long
Dim db As Dao.Database, rst As Dao.Recordset
Dim qdf As Dao.QueryDef
Dim prm As Dao.Parameter
Dim BDateB As Date, EDateB As Date
Set db = CurrentDb
Set qdf = db.QueryDefs(qryName)
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = db.OpenRecordset(dbOpenDynaset)
BDateB = DateSerial(Yr, Mth, 1)
Select Case Mth
Case 4, 6, 9, 11
EDateB = DateSerial(Yr, Mth, 30)
Case 2
EDateB = DateSerial(Yr, Mth, 28)
Case Else
EDateB = DateSerial(Yr, Mth, 31)
End Select
' loop through each record occurs here.
Do Until rst.BOF
Select Case BDate
Case BDate < BDateB
If EDate < BDateB Then
NrMth = 0
Else
If Month(EDate) <= Month(BDateB) Then
NrMth = Month(EDate)
Else
NrMth = Month(BDateB)
End If
End If
Case Else
NrMth = 11 ' Just for testing purposes. If this works I will go on with more IF statements
End Select
rst.MovePrevious
Loop
Set rst = Nothing
Set db = Nothing
Set qdf = Nothing
End Function
At the moment my function is not complete. I just try to test the working of the principle. I get several error messages with this function.
First there is a problem with "Set rst = db.OpenRecordset(dbOpenDynaset)". I get the ERROR 3078 (it can't find table or query "2"). When I change this Set rst to "Set rst = db.OpenRecordset(qryName, dbOpenDynaset)" it returns the "too few parameters Expected 2" error
Second there is a problem with the variables [Yr] and [Mth]. When looping through the parameters the function does not seem to recognize these. When going over the Eval(prm.Name) with the mouse pointer I can see the value is "[Yr]" (including the "") or "[Mth]".
I wonder what I do wrong
I have a table containing items with a start date and an end date.
In a query I try to calculate the number of months that the items from the table are within the period that is requested by the query.
Example: when I run my query it will pop up two dialog boxes, one asking for [Yr] and one for [Mth]. So when [Yr] = 2011 and [Mth]= 5 I trie to find from each item in the table how many months fall between Jan 1, 2011 and May 31, 2011.
Since the calculation of the number of months that fall within the required period takes several IFF statements, I tried to create a VBA function. After several hours of inquiry on the internet my table, query and function look like:
The table:
ID 'unique identifier
Anr 'code
Bdate 'begin date
Edate 'end date
The query (called qryB)
SELECT tblB.ID, tblB.Anr, tblB.BDate, tblB.EDate, NrMth("qryB",[BDate],[EDate],[Yr],[Mth]) AS NrMonths
FROM tblB
ORDER BY tblB.Anr;
The function
Public Function NrMth(qryName As String, BDate As Date, EDate As Date, Yr, Mth) As Long
Dim db As Dao.Database, rst As Dao.Recordset
Dim qdf As Dao.QueryDef
Dim prm As Dao.Parameter
Dim BDateB As Date, EDateB As Date
Set db = CurrentDb
Set qdf = db.QueryDefs(qryName)
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = db.OpenRecordset(dbOpenDynaset)
BDateB = DateSerial(Yr, Mth, 1)
Select Case Mth
Case 4, 6, 9, 11
EDateB = DateSerial(Yr, Mth, 30)
Case 2
EDateB = DateSerial(Yr, Mth, 28)
Case Else
EDateB = DateSerial(Yr, Mth, 31)
End Select
' loop through each record occurs here.
Do Until rst.BOF
Select Case BDate
Case BDate < BDateB
If EDate < BDateB Then
NrMth = 0
Else
If Month(EDate) <= Month(BDateB) Then
NrMth = Month(EDate)
Else
NrMth = Month(BDateB)
End If
End If
Case Else
NrMth = 11 ' Just for testing purposes. If this works I will go on with more IF statements
End Select
rst.MovePrevious
Loop
Set rst = Nothing
Set db = Nothing
Set qdf = Nothing
End Function
At the moment my function is not complete. I just try to test the working of the principle. I get several error messages with this function.
First there is a problem with "Set rst = db.OpenRecordset(dbOpenDynaset)". I get the ERROR 3078 (it can't find table or query "2"). When I change this Set rst to "Set rst = db.OpenRecordset(qryName, dbOpenDynaset)" it returns the "too few parameters Expected 2" error
Second there is a problem with the variables [Yr] and [Mth]. When looping through the parameters the function does not seem to recognize these. When going over the Eval(prm.Name) with the mouse pointer I can see the value is "[Yr]" (including the "") or "[Mth]".
I wonder what I do wrong