I have code written to send an email when a submit box is checked on a form. The code loops through and sends the email for each record selected and moves the check mark to "processed" once the email is sent. The code works great with one exception, when I close the form used to select the records to email, I receive a "Write Conflict." I understand that this may be a result of having a form open that is based on a query, and that my VBA code is filtering and editing records directly from the table and not the form or the query. Because I am new to VBA I am looking for suggestions on how to best resolve this issue. I have tried a few methods to pull the records from the query once the user selects the records for submission, but have not been successful. I understand that the VBA code may be a little messy, but am willing to take any suggestions.
Code:
Sub SendEmail()
Response = MsgBox("Are you sure you want to submit these records?" & vbCrLf & vbCrLf & "Remedy tickets will be created." & vbCrLf & vbCrLf & "THIS CANNOT BE UNDONE.", 52)
If Response = vbNo Then
GoTo Done
Else
End If
Dim r As DAO.Recordset
Set r = CurrentDb.OpenRecordset("SELECT * FROM CIs_All_Statuses WHERE Submit = True")
If r.RecordCount = 0 Then
MsgBox ("No records selected")
GoTo Done
Else
End If
r.MoveFirst
i = 1
Begin:
Do Until r.EOF = True
product = r![Product Name]
serial = r![Serial Number]
agency = r![Company]
User = r![Used By]
Submit = r![Submit]
Processed = r![Processed]
If Processed = True Then
r.Edit
r("Submit").Value = False
r.Update
r.MoveNext
GoTo Begin
Else
Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem
' prevent 429 error, if outlook not open
On Error Resume Next
Err.Clear
Set oOutlook = GetObject(, "Outlook.application")
If Err.Number <> 0 Then
Set oOutlook = New Outlook.Application
End If
Set oEmailItem = oOutlook.CreateItem(olMailItem)
With oEmailItem
.To = "Mail Address"
.Subject = "EmailTicket: [TSD-CI-Data-Validation-Required]"
.Body = "Equipment to be verified:" & Space(2) & product & vbCrLf & "Serial Number:" & Space(2) & serial & vbCrLf & "Agency:" & Space(2) & agency & vbCrLf & "User Name:" & Space(2) & User & vbCrLf & vbCrLf & "By inserting the user name in the CC line the Customer Information on the Incident Customer tab will be auto-completed. ONLY append information to the end of the SUBJECT LINE"
.Display
End With
r.Edit
r("Processed").Value = True
r.Update
r.Edit
r("Submit").Value = False
r.Update
r.MoveNext
Do While r.EOF = False
NextComputer = r![Serial Number]
If (serial = NextComputer) Then
GoTo Begin
Else
r.MovePrevious
End If
Loop
r.MovePrevious
End If
Loop
r.Close
Set r = Nothing
Done:
MsgBox ("All email tickets have been sent.")
End Sub
