I have setup a small test database with which has three tables:
RsrcHoursWorked - Contains information pertaining to hours worked by a resource in a given week (ADMUSER2_FINDATESSTART_DATE).
Rsrcrate- Contains all of the available rates and there effective date for each resource.
RsrcRateByFinPrd - A temporary table that is recreated when the user click the Test button. After excuting the code below, the table will contain information from the RsrcHoursWorked and Rsrcrate table, which aligns the hours worked by a resource with the hourly rate that was effective when the work was performed.
This is my first time working with databases and was looking for some constructive feedback on my code, or suggestions on how to improve it. I attached a copy of the test database below.
Thanks in advance,
Rod
RsrcHoursWorked - Contains information pertaining to hours worked by a resource in a given week (ADMUSER2_FINDATESSTART_DATE).
Rsrcrate- Contains all of the available rates and there effective date for each resource.
RsrcRateByFinPrd - A temporary table that is recreated when the user click the Test button. After excuting the code below, the table will contain information from the RsrcHoursWorked and Rsrcrate table, which aligns the hours worked by a resource with the hourly rate that was effective when the work was performed.
This is my first time working with databases and was looking for some constructive feedback on my code, or suggestions on how to improve it. I attached a copy of the test database below.
Code:
Private Sub btnTest_Click()
On Error GoTo Err_btnTest_Click
Dim db As Database
Dim rsTarget As DAO.Recordset
Dim strSQL As String
Dim sSQL_DEL As String
Dim strSQL_SEL As String
Dim strSQL_UPDATE As String
Dim vStr As Variant
DoCmd.SetWarnings True
DoCmd.Hourglass True
'Open connection to current Access database
Set db = CurrentDb()
' Delete query
sSQL_DEL = "DELETE * FROM RsrcRateByFinPrd"
' Run query to ensure the table is empty
DoCmd.RunSQL (sSQL_DEL)
' Append query to populate RsrcRateByFinPrd table in DESC order
strSQL = "INSERT INTO RsrcRateByFinPrd ( Rsrc_ID, ADMUSER2_FINDATESSTART_DATE ) " & _
"SELECT DISTINCT [RsrcHoursWorked].[RSRC_ID], [RsrcHoursWorked].[ADMUSER2_FINDATESSTART_DATE] " & _
"FROM RsrcHoursWorked " & _
"ORDER BY [RsrcHoursWorked].[RSRC_ID], [RsrcHoursWorked].[ADMUSER2_FINDATESSTART_DATE] DESC;"
' Run query to populate RsrcRateByFinPrd table
DoCmd.RunSQL (strSQL)
Set rsTarget = db.OpenRecordset("RsrcRateByFinPrd")
rsTarget.MoveFirst
Do Until rsTarget.EOF
Set vCurID = rsTarget.Fields(0)
' Select query to retrieve RsrcRate info in DESC order
strSQL_SEL = "SELECT [Rsrcrate].[RSRC_RATE_ID], [Rsrcrate].[RSRC_ID], [Rsrcrate].[START_DATE], [Rsrcrate].[COST_PER_QTY], [Rsrcrate].[COST_PER_QTY2], [Rsrcrate].[COST_PER_QTY3], [Rsrcrate].[COST_PER_QTY4], [Rsrcrate].[COST_PER_QTY5]" & vbCrLf & _
"FROM Rsrcrate " & vbCrLf & _
"WHERE [Rsrcrate].[RSRC_ID]=" & rsTarget.Fields(1) & " " & vbCrLf & _
"ORDER BY [Rsrcrate].[START_DATE] DESC;"
Dim rsFind As DAO.Recordset
Set rsFind = db.OpenRecordset(strSQL_SEL, , dbSQLPassThrough)
rsFind.MoveFirst
Dim vCost As Variant
Dim vCost2 As String
If rsFind.RecordCount = 0 Then
strSQL_UPDATE = "UPDATE RsrcRateByFinPrd" & vbCrLf & _
"SET RSRC_RATE_ID =" & rsFind.Fields(0) & vbCrLf & _
", COST_PER_QTY =" & 0 & vbCrLf & _
", COST_PER_QTY2 =" & 0 & vbCrLf & _
"WHERE [RsrcRateByFinPrd].[ID]=" & vCurID & ";"
DoCmd.RunSQL (strSQL_UPDATE)
ElseIf rsFind.RecordCount = 1 Then
' Check for NULL value
If IsNull(rsFind.Fields(3)) Then
vCost = 0
Else
vCost = rsFind.Fields(3)
End If
' Check for NULL value
If IsNull(rsFind.Fields(4)) Then
vCost2 = 0
Else
vCost2 = rsFind.Fields(4)
End If
strSQL_UPDATE = "UPDATE RsrcRateByFinPrd" & vbCrLf & _
"SET RSRC_RATE_ID =" & rsFind.Fields(0) & vbCrLf & _
", COST_PER_QTY =" & vCost & vbCrLf & _
", COST_PER_QTY2 =" & vCost2 & vbCrLf & _
"WHERE [RsrcRateByFinPrd].[ID]=" & vCurID & ";"
'Run query
DoCmd.RunSQL (strSQL_UPDATE)
Else
Dim iCnt, iMax As Integer
Dim bFound As Boolean
Dim sMsg As String
bFound = False
iCnt = 0
iMax = rsFind.RecordCount
While iCnt < iMax
If rsFind.Fields(2) <= rsTarget.Fields(3) And bFound = False Then
' Check for NULL value
If IsNull(rsFind.Fields(3)) Then
vCost = 0
Else
vCost = rsFind.Fields(3)
End If
' Check for NULL value
If IsNull(rsFind.Fields(4)) Then
vCost2 = 0
Else
vCost2 = rsFind.Fields(4)
End If
strSQL_UPDATE = "UPDATE RsrcRateByFinPrd" & vbCrLf & _
"SET RSRC_RATE_ID = " & rsFind.Fields(0) & vbCrLf & _
", COST_PER_QTY =" & vCost & vbCrLf & _
", COST_PER_QTY2 =" & vCost2 & vbCrLf & _
"WHERE [RsrcRateByFinPrd].[ID]=" & vCurID & ";"
'Run query
DoCmd.RunSQL (strSQL_UPDATE)
' Set to true since we found the correct rate
bFound = True
' Set to iMax to end While loop
iCnt = iMax
ElseIf iCnt < iMax Then
iCnt = iCnt + 1
'Get next record if we haven't found our rate and there are additional records
rsFind.MoveNext
ElseIf iCnt = iMax Then
If bFound = False Then
strSQL_UPDATE = "UPDATE RsrcRateByFinPrd" & vbCrLf & _
"SET RSRC_RATE_ID = " & rsFind.Fields(0) & vbCrLf & _
", COST_PER_QTY =" & 0 & vbCrLf & _
", COST_PER_QTY2 =" & 0 & vbCrLf & _
"WHERE [RsrcRateByFinPrd].[ID]=" & vCurID & ";"
'Run query
DoCmd.RunSQL (strSQL_UPDATE)
End If
End If
Wend
End If
rsTarget.MoveNext
Loop
rsTarget.Close
rsFind.Close
Set rsTarget = Nothing
Set rsFind = Nothing
DoCmd.SetWarnings False
DoCmd.Hourglass False
Exit_btnTest_Click:
Exit Sub
Err_btnTest_Click:
MsgBox Err.Description
Resume Exit_btnTest_Click
End Sub
Thanks in advance,
Rod