Private Sub cmdAllocate_Click()
On Error GoTo Err_Handler
Dim dbsPA As Database
Dim rstWA As Recordset
Dim rstPA As Recordset
Dim strSQLWA As String, strSQLPA As String
Dim strProduct As String, strMethod As String, StrQueue As String, strUser As String, strProgress As String
Dim intAllocate As Integer, intLoop As Integer, lngTotalAllocated As Long
Dim curLimit As Long, curAmount As Long
Dim blnShort As Boolean
'Set dbsPA = OpenDatabase("PA_Allocation")
Set dbsPA = CurrentDb()
'SQL statement to get Payment Analysts
strSQLPA = "SELECT Analyst.File_ID, Analyst.Full_Name, Analyst.Queue, Analyst.Product, Analyst.Pay_Method, Analyst.Workstream, Analyst.Allocation, Analyst.Received, Analyst.Working "
strSQLPA = strSQLPA & "FROM Analyst WHERE (((Analyst.Working)=True)) ;"
' SQL statement to get data to be allocated
Set rstPA = dbsPA.OpenRecordset(strSQLPA)
'We are progressing, so open Progress form that will act as a status update to user
'DoCmd.OpenForm "Progress"
'Forms!Progress.txtProgress.Value = " Starting Allocation..."
'Forms!Progress.Refresh
Do While Not rstPA.EOF
' First get the extra criteria for the recordset
strProduct = Chr$(39) & rstPA.Fields("Product") & Chr$(39)
strMethod = Chr$(39) & rstPA.Fields("Pay_Method") & Chr$(39)
StrQueue = Chr$(39) & rstPA.Fields("Queue") & Chr$(39)
strUser = rstPA.Fields("Full_Name")
intAllocate = rstPA.Fields("Allocation")
' Payment limits are £5000 or £100,000
If rstPA.Fields("Workstream") = "Under 5K" Then
curLimit = 5000
Else
curLimit = 100000
End If
strSQLWA = "SELECT Daily_Work_Allocation.Amount, Daily_Work_Allocation.Process_Payment_Cashiers_allocated_to_name, Daily_Work_Allocation.payment_method, Daily_Work_Allocation.product_01, Daily_Work_Allocation.Payment_Case_Awaiting_Payment_allocated_to_name FROM Daily_Work_Allocation "
strSQLWA = strSQLWA & "WHERE (((Daily_Work_Allocation.Payment_Case_Awaiting_Payment_allocated_to_name) = '') AND ((Daily_Work_Allocation.Process_Payment_Cashiers_allocated_to_name)= " & StrQueue & ") AND ((Daily_Work_Allocation.payment_method)=" & strMethod & ") AND ((Daily_Work_Allocation.product_01)=" & strProduct & ")"
strSQLWA = strSQLWA & " AND ((Daily_Work_Allocation.Status) = '" & Me.cmbStatus & "'));"
' MsgBox strSQLWA
Set rstWA = dbsPA.OpenRecordset(strSQLWA, dbOpenDynaset)
intLoop = 0
If Not rstWA.EOF Then
rstWA.MoveFirst
Else
MsgBox "No payments found for " & strProduct & " " & strMethod & " for queue " & StrQueue
End If
' Debug.Print rstWA.RecordCount
Do While intLoop < intAllocate And Not rstWA.EOF
curAmount = rstWA.Fields("amount")
' Check the PA is authorised for the amount of payment
If curAmount <= curLimit Then
With rstWA
.Edit
.Fields("Payment_Case_Awaiting_Payment_allocated_to_name").Value = strUser
.Update
End With
intLoop = intLoop + 1
End If
rstWA.MoveNext
Loop
lngTotalAllocated = lngTotalAllocated + intLoop
'Now update Analyst table with amount allocated.
With rstPA
.Edit
.Fields("Received").Value = .Fields("Received").Value + intLoop
.Update
End With
' Now close WA ready for next select
rstWA.Close
rstPA.MoveNext
Loop
' Now refresh the Crosstab datasheet
' Me.[Daily_Work_Allocation_Crosstab_subform].Form.Refresh
Set dbsPA = Nothing
Set rstPA = Nothing
Set rstWA = Nothing
Me.Refresh
MsgBox lngTotalAllocated & " payments allocated..."
Err_Exit:
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & " " & Err.Description
Resume Err_Exit
End Sub