trouble with Do While Not rst.EOF....Loop

sjl · Apr 9, 2009

Hi.

I have 2 loops for some VBA code to go through in order to analyze dates and send out email notification (if conditions are met), but the 2nd loop is not running. Anyone see my error? I've condensed my program for quicker review.
=============================================
Option Compare Database
Option Explicit

Private Sub Form_Load()

Const cdoSendUsingPort = 2
Const cdoBasic = 1
Dim objCDOConfig As Object, objCDOMessage As Object
Dim strSch As String

Dim rst As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set rst = db.OpenRecordset("qryEmail_Notif_NIEHS")

Dim dtToday As Date
Dim dtPacketDue As Date
etc, etc…..

On Error GoTo Cleanup

dtToday = Date 'todays date

strSch = "http://schemas.microsoft.com/cdo/configuration/"
Set objCDOConfig = CreateObject("CDO.Configuration")
With objCDOConfig.Fields
.Item(strSch & "sendusing") = 2
.Item(strSch & "smtpserver") = "smtp.xxxxx.yyy.gov"
.Item(strSch & "smtpserverport") = 25
.Item(strSch & "smtpconnectiontimeout") = 60
.Update
End With

'first DO Loop

Do While Not rst.EOF

dtPacketDue = rst!dtmNPacketDue
dtCOIDue = rst!dtmCOIDueDate
strTo = rst!strSMName 'study manager I NAME
strCC = rst!strSMNameII 'study manager II NAME
strEM = rst!strEmail_SM 'study manager I EMAIL
strEM2 = rst!strEmail_SM2 'study manager II EMAIL
strproject = rst!strBrochureName
strprotocol = rst!strNIHProtocolNum

If DateDiff("w", dtToday, dtPacketDue, vbTuesday, vbFirstJan1) < 10 Then
daysFromNowNIH10 = DateDiff("d", dtToday, dtPacketDue)
If DateDiff("w", dtToday, dtPacketDue, vbTuesday, vbFirstJan1) < 10 Then
Set objCDOMessage = CreateObject("CDO.Message")
With objCDOMessage
Set .Configuration = objCDOConfig
.Subject = "IRB: NIEHS Packet Due Date in < 10 weeks " & "-- " & strproject
.from = "me@xxx.yyy.gov"
.To = "me@xxx.yyy.gov"

.htmlbody = "<HTML><BODY> " & strTo & " " & strCC & " " & _
"The NIEHS packet due date for " & strproject & " (protocol# " & strprotocol & ") is: " & _
" " & dtPacketDue & " "
.Send
End With
End If
End If
rst.MoveNext
Loop

Set objCDOMessage = Nothing

'SECOND DO LOOP

Do While Not rst.EOF

dtPacketDue = rst!dtmNPacketDue
dtCOIDue = rst!dtmCOIDueDate
strTo = rst!strSMName 'study manager I NAME
strCC = rst!strSMNameII 'study manager II NAME null problem if declared as a string--declare as Variant
strEM = rst!strEmail_SM 'study manager I EMAIL
strEM2 = rst!strEmail_SM2 'study manager II EMAIL null problem if declared as a string--declare as Variant
strproject = rst!strBrochureName
strprotocol = rst!strNIHProtocolNum

If DateDiff("w", dtToday, dtPacketDue, vbTuesday, vbFirstJan1) > 10 Then
daysFromNowNIH10 = DateDiff("d", dtToday, dtPacketDue)
If DateDiff("w", dtToday, dtPacketDue, vbTuesday, vbFirstJan1) > 10 Then
Set objCDOMessage = CreateObject("CDO.Message")
With objCDOMessage
Set .Configuration = objCDOConfig
.Subject = "IRB: Packet Due Date in > 10 weeks " & "-- " & strproject
.from = "lein@xxx.yyy.gov"
.To = "lein@xxx.yyy.gov"

.htmlbody = "<HTML><BODY> " & strTo & " " & strCC & " " & _
"The NIEHS packet due date for " & strproject & " (protocol# " & strprotocol & ") is: " & _
" " & dtPacketDue & " "
.Send
End With
End If
End If
rst.MoveNext
Loop

Set objCDOMessage = Nothing
Set objCDOConfig = Nothing

Cleanup:
rst.Close
CurrentDb.Close
Set rst = Nothing
On Error GoTo 0

End Sub

Thanks,
Sarah

boblarson · Apr 9, 2009

When you get to the second Do Until rst.EOF it is at the EOF. You would need to reset before starting the second loop by

rst.MoveFirst

sjl · Apr 9, 2009

Bob,

You the man. That works.

gracias!

Khalid_Afridi · Mar 16, 2010

Bob is the best

Khalid

trouble with Do While Not rst.EOF....Loop

sjl

Registered User.

boblarson

Smeghead

sjl

Registered User.

Khalid_Afridi

Registered User.

Similar threads

Users who are viewing this thread