ReceiptNo: Year([dt_ContributionDate]) & Format([lngMemberNo], "0000000")
Public Sub GenereateTestData()
'Variables
Dim lngMemberNo As Long
Dim intRandom As Integer
Dim intAmountType As Integer
Dim intI As Integer
'Open table contributions for data entry
Dim rsContributions As DAO.Recordset
Set rsContributions = CurrentDb.OpenRecordset("tbl_Contributions", dbOpenDynaset)
With rsContributions
'Loop through creating a random number (1-50) of contributions for each member
For lngMemberNo = 1 To 100
intRandom = Int(Rnd() * 50 + 1)
For intI = 1 To intRandom
.AddNew
!FK_MemberNo = lngMemberNo
'Create random date between 2010-01-01 and 2012-12-31
!dt_Date = DateAdd("d", Int(Rnd() * 1095), #1/1/2010#)
intAmountType = Int(Rnd() * 4 + 1)
Select Case intAmountType
Case 1
!lng_Amount1 = Int(Rnd() * 1000 + 1)
Case 2
!lng_Amount2 = Int(Rnd() * 1000 + 1)
Case 3
!lng_Amount3 = Int(Rnd() * 1000 + 1)
Case 4
!lng_Amount4 = Int(Rnd() * 1000 + 1)
End Select
.Update
Next intI
Next lngMemberNo
End With
'Cleanup
Set rsContributions = Nothing
End Sub
Public Function GenerateYearlyData(lngYear As Long) As Integer
On Error GoTo err_Handler
'First make some very basic error validation. You may or may not want to expand on this. Your call
If lngYear < 2010 Or lngYear > 2030 Then
MsgBox "The year entered [" & lngYear & "] is invalid. Valid data range is:" & _
"2010 to 2030"
GenerateYearlyData = vbNo
Exit Function
End If
'Check that no entries allready exist in tbl_YearlyReceipt for requested year, as that would indicate some sort of problem
If DCount("*", "tbl_YearlyReceipt", "lng_Year=" & lngYear) > 0 Then
MsgBox "The year requested [" & lngYear & "] allready exists in table"
GenerateYearlyData = vbNo
Exit Function
End If
'Encapsulate in transaction, in case error occurs
Dim wks As DAO.Workspace
Dim myDB As DAO.Database
Set wks = DBEngine.Workspaces(0)
Set myDB = CurrentDb
'Now run query to sum up the yearly amount and transfer to tbl_YearlyReceipt
Dim strSQL As String
strSQL = "INSERT INTO tbl_YearlyReceipt ( FK_MemberNo, lng_Year, lng_SumAmount1, lng_SumAmount2, lng_SumAmount3, lng_SumAmount4 )" & _
" SELECT tbl_Contributions.FK_MemberNo, Year([dt_Date]) AS YearValue, Sum(tbl_Contributions.lng_Amount1) AS SumOflng_Amount1, Sum(tbl_Contributions.lng_Amount2) AS SumOflng_Amount2, Sum(tbl_Contributions.lng_Amount3) AS SumOflng_Amount3, Sum(tbl_Contributions.lng_Amount4) AS SumOflng_Amount4 " & _
" FROM tbl_Contributions " & _
" WHERE (((tbl_Contributions.dt_Date) >= #1/1/" & lngYear & "# And (tbl_Contributions.dt_Date) < #1/1/" & lngYear + 1 & "#)) " & _
" GROUP BY tbl_Contributions.FK_MemberNo, Year([dt_Date]); "
wks.BeginTrans
myDB.Execute strSQL, dbFailOnError
'Now open recordset to add the receiptnumber
Dim rsYearlyReceipt As DAO.Recordset
Set rsYearlyReceipt = myDB.OpenRecordset("SELECT * FROM tbl_YearlyReceipt where lng_Year=" & lngYear, dbOpenDynaset)
Dim lngRecieptNumber As Long
lngRecieptNumber = 1
Dim strRecipt As String
Do While Not rsYearlyReceipt.EOF
rsYearlyReceipt.Edit
rsYearlyReceipt!tx_ReceiptNumber = lngYear & Format(lngRecieptNumber, "000000")
rsYearlyReceipt.Update
lngRecieptNumber = lngRecieptNumber + 1
rsYearlyReceipt.MoveNext
Loop
'Succesfull
wks.CommitTrans
GenerateYearlyData = vbYes
cleanup:
Set wks = Nothing
Set myDB = Nothing
Set rsYearlyReceipt = Nothing
Exit Function
err_Handler:
MsgBox "An error occured while trying to generate yearly recipts data" & vbNewLine & _
Err.Number & " - " & Err.Description
GenerateYearlyData = vbError
If Not wks Is Nothing Then wks.Rollback
Resume cleanup
End Function
Comment