流程记录EOF

时间:2016-02-16 19:43:06

标签: vba email ms-access access-vba

想知道是否有人可以帮我解决这个问题。有一个Access数据库,我想为每个人发送一封电子邮件"提交"选中的复选框。尝试了几件事,要么在代码停止之前处理1条记录,要么在不继续操作的情况下为同一条记录提供几封电子邮件。任何有关我错过船的帮助都将非常感激。以下是我对代码的看法:

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
End If

r.Edit
r("Processed").Value = True
r.Update

r.Edit
r("Submit").Value = False
r.Update

r.MoveNext

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 = "@email.com"
.CC = Me.Used_By
.Subject = "EmailTicket: [Subject]"
.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.MoveNext

Check:
Do While r.EOF = False

    NextComputer = r![Serial Number]
    If (serial = NextComputer) Then
        r.Edit
        r("Submit").Value = False
        r.Update
        r.Edit
        r("Processed").Value = True
        r.Update
        r.MoveNext
        GoTo Check
        Else
        r.MovePrevious
        End If
Loop
r.MovePrevious

Loop
r.Close
Set r = Nothing

Done:

End Sub

1 个答案:

答案 0 :(得分:0)

除其他事项外,还有GoTo Check

删除它并重建循环。 此外,每条记录只需要一个.Edit.Update