Sending E-mail

[incognito8095]

Hey there,

I get all the way through the code but receive an error at the .movenext shown below...Any suggestions?

Public Function SendEmail()

PROC_DECLARATIONS:
Dim olApp As Outlook.Application
Dim olnamespace As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim dbs As Database
Dim rstEmailDets As Recordset
Dim strSender As String
Dim strRecipient As String
Dim strEmail As String

PROC_START:
On Error GoTo PROC_ERROR

PROC_MAIN:
DoCmd.SetWarnings False

Set dbs = CurrentDb

'Put on hourglass
DoCmd.Hourglass True

'Collect the email details in a recordset to use in the email loop below
Set rstEmailDets = dbs.OpenRecordset("SELECT PersonsName, PersonsEmail FROM TableName;")

With rstEmailDets
.MoveFirst
Do While Not rstEmailDets.EOF

'Set parameters for email: recipient name, recipient email
strRecipient = Nz(rstEmailDets("PersonsName"), "")
strEmail = Nz(rstEmailDets("PersonsEmail"), "")


With dbs

'Create a new instance of an Outlook Application object
Set olApp = New Outlook.Application
Set olnamespace = olApp.GetNamespace("MAPI")
Set olMail = olApp.CreateItem(olMailItem)

With olMail

'Email Details
.To = strEmail
.Subject = "Greetings " & strRecipient
.Body = vbCrLf & _
"Dear " & strRecipient & "," & vbCrLf & vbCrLf & _
"Put your message Here" & vbCrLf & vbCrLf & " "
.Importance = olImportanceNormal
.Send

End With
.MoveNext
Loop

End With

MsgBox "All Emails have now been sent, Thank you for your patience"

PROC_EXIT:
' Perform cleanup code here, set recordsets to nothing, etc.
On Error Resume Next
DoCmd.RunCommand acCmdWindowHide '(hides the database window)
Set olApp = Nothing
Set olnamespace = Nothing
Set olMail = Nothing
Set dbs = Nothing
Set rstEmailDets = Nothing
DoCmd.Hourglass False
Exit Function

PROC_ERROR:
If Err = -2147467259 Then
MsgBox "You have exceeded the storage limit on your mail box. Please delete some items before clicking OK", vbOKOnly
Resume
End If

If Err = 2501 Then
MsgBox "You have attempted to cancel the output of the emails." & vbCrLf & _
"This will cause major problems." & vbCrLf & _
"Please be Patient"
Resume
End If

End Function

 

[ByteMyzer]

Remove the following statement:

With dbs