"Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record."
Any help would be much appreciated! Here is the code (Everything after the whole recSet5.AddNew part should work properly and has been tested):
Expand|Select|Wrap|Line Numbers
- Private Sub cmdClaimsReleased_Click()
- On Error GoTo Err_cmdClaimsReleased_Click
- DoCmd.SetWarnings False
- DoCmd.OpenQuery ("ClearTblClaimSearch")
- DoCmd.OpenQuery ("ClearTblTimeDifference")
- DoCmd.OpenQuery ("ClearTblConvertedDates")
- DoCmd.OpenQuery ("ClearTblOutputData")
- DoCmd.OpenQuery ("ClearTblQuantities")
- 'Opening ADODB connections and record sets
- Dim con1 As ADODB.Connection
- Dim con2 As ADODB.Connection
- Dim con3 As ADODB.Connection
- Dim con4 As ADODB.Connection
- Dim con5 As ADODB.Connection
- Dim recSet1 As ADODB.Recordset
- Dim recSet2 As ADODB.Recordset
- Dim recSet3 As ADODB.Recordset
- Dim recSet4 As ADODB.Recordset
- Dim recSet5 As ADODB.Recordset
- Set con1 = CurrentProject.Connection
- Set con2 = CurrentProject.Connection
- Set con3 = CurrentProject.Connection
- Set con4 = CurrentProject.Connection
- Set con5 = CurrentProject.Connection
- Set recSet1 = New ADODB.Recordset
- Set recSet2 = New ADODB.Recordset
- Set recSet3 = New ADODB.Recordset
- Set recSet4 = New ADODB.Recordset
- Set recSet5 = New ADODB.Recordset
- 'setting records and connections to actual tables
- recSet1.Open "tblClaimSearch", con1, adOpenKeyset, adLockOptimistic
- recSet2.Open "tblOutputData", con2, adOpenKeyset, adLockOptimistic
- recSet3.Open "tblTimeDifference", con3, adOpenKeyset, adLockOptimistic
- recSet4.Open "tblQuantities", con4, adOpenKeyset, adLockOptimistic
- recSet5.Open "tblConvertedDates", con5, adOpenKeyset, adLockOptimistic
- DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tblClaimSearch", "C:\Documents and Settings\jpollard\Desktop\ClaimSearchResult", True
- recSet1.MoveFirst
- Do Until recSet1.EOF
- recSet5.AddNew
- If Not IsNull(recSet1.Fields("LOAD_DATE")) Then
- recSet5.Fields("LOAD_DATE2") = CDate(Format(recSet1.Fields("LOAD_DATE"), "00\/00\/0000"))
- End If
- If Not IsNull(recSet1.Fields("DATE_SENT")) Then
- recSet5.Fields("DATE_SENT2") = CDate(Format(recSet1.Fields("DATE_SENT"), "00\/00\/0000"))
- End If
- If Not IsNull(recSet1.Fields("CLAIM_START")) Then
- recSet5.Fields("CLAIM_START2") = CDate(Format(recSet1.Fields("CLAIM_START"), "00\/00\/0000"))
- End If
- If Not IsNull(recSet1.Fields("CLAIM_END")) Then
- recSet5.Fields("CLAIM_END2") = CDate(Format(recSet1.Fields("CLAIM_END"), "00\/00\/0000"))
- End If
- If Not IsNull(recSet1.Fields("OUT_DATE")) Then
- recSet5.Fields("OUT_DATE2") = recSet1.Fields("OUT_DATE")
- End If
- recSet5.Update
- recSet1.MoveNext
- Loop
- Dim TimeDifference As Integer
- Dim X As Integer
- Dim Y As Integer
- Dim Z As Integer
- Dim Q As Integer
- Dim N As Integer
- Dim DailyPercentage As Integer
- Dim IsOutlookOpen As Boolean
- Q = 0
- X = 0
- N = 0
- recSet5.MoveFirst
- Do Until recSet5.EOF
- If IsNull(recSet5.Fields("OUT_DATE")) = True Then
- N = N + 1
- Else
- TimeDifference = DateDiff("d", recSet5.Fields("LOAD_DATE2"), recSet5.Fields("OUT_DATE2"))
- recSet3.AddNew
- recSet3.Fields("TimeDifference") = TimeDifference
- recSet3.Update
- End If
- If TimeDifference > X Then
- X = TimeDifference
- End If
- Q = Q + 1
- recSet5.MoveNext
- Loop
- Y = 0
- Z = 0
- Do Until Y > X
- recSet3.MoveFirst
- Do Until recSet3.EOF
- If Y = recSet3.Fields("TimeDifference") Then
- Z = Z + 1
- End If
- recSet3.MoveNext
- Loop
- DailyPercentage = ((Z / Q) * 100)
- recSet2.AddNew
- recSet2.Fields("Days") = Y
- recSet2.Fields("Claims") = Z
- recSet2.Fields("PercentageOfTotal") = DailyPercentage
- recSet2.Update
- Y = Y + 1
- Z = 0
- Loop
- recSet4.AddNew
- recSet4.Fields("Q") = Q
- recSet4.Fields("N") = N
- recSet4.Update
- Dim objOutlookRecip As Outlook.Recipient
- Dim outObj As Outlook.Application
- Set outObj = CreateObject("outlook.application")
- Dim olNs As Outlook.NameSpace
- Set olNs = outObj.GetNamespace("MAPI")
- olNs.Logon
- IsOutlookOpen = True
- Dim outMail As Outlook.MailItem
- Set outMail = outObj.CreateItem(olMailItem)
- outMail.To = "jordan.pollard@multiplan.com"
- outMail.Subject = "Percentage of Claims Released"
- recSet2.MoveFirst
- Do Until recSet2.EOF
- outMail.Body = _
- outMail.Body & " Days: " & recSet2.Fields("Days") & " Claims: " & recSet2.Fields("Claims") & " Percentage Of Total: " & recSet2.Fields("PercentageOfTotal")
- recSet2.MoveNext
- Loop
- recSet4.MoveFirst
- Do Until recSet4.EOF
- outMail.Body = _
- outMail.Body & "There were/was " & recSet4.Fields("N") & " claim(s) that have not yet gone outbound." & vbNewLine _
- & "There was a total of " & recSet4.Fields("Q") & " claim(s) in the load."
- recSet4.MoveNext
- Loop
- outMail.Send
- Set outMail = Nothing
- Set outObj = Nothing
- 'Closing connections and clearing record sets
- recSet1.Close
- recSet2.Close
- recSet3.Close
- recSet4.Close
- recSet5.Close
- con1.Close
- con2.Close
- con3.Close
- con4.Close
- con5.Close
- Set con1 = Nothing
- Set con2 = Nothing
- Set con3 = Nothing
- Set con4 = Nothing
- Set con5 = Nothing
- Set recSet1 = Nothing
- Set recSet2 = Nothing
- Set recSet3 = Nothing
- Set recSet4 = Nothing
- Set recSet5 = Nothing
- DoCmd.OpenQuery ("ClearTblClaimSearch")
- DoCmd.OpenQuery ("ClearTblTimeDifference")
- DoCmd.OpenQuery ("ClearTblOutputData")
- DoCmd.OpenQuery ("ClearTblQuantities")
- DoCmd.OpenQuery ("ClearTblConvertedDates")
- DoCmd.SetWarnings True
- Exit_cmdClaimsReleased_Click:
- Exit Sub
- Err_cmdClaimsReleased_Click:
- MsgBox Err.Description
- Resume Exit_cmdClaimsReleased_Click
- End Sub
Kosmös