Sending E-mails

[alastair69]

Hello All,

I have found various postings on how to send e-mails, but for some reason i can not get the code to run. If someone would be kind enough to have a look for me.

What i would like to happen is for the contact name to be placed in the "To" box of outlook (version 11), and then to beable to write the e-mail as normal.

The code is:

Private Sub cmdEmail_Click()
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 ContactName, ContactEmail FROM JT Contact List;")

With rstEmailDets
.MoveFirst
Do While Not rstEmailDets.EOF

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


'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 Sub

If anybody can help i would be most greatful.

Alastair

Update: Resolved by http://www.access-programmers.co.uk/forums/showthread.php?t=100584

**********************************RESOLVED THANKS TO HEYLEY BAXTER***************************

 

[DB7]

A rather simple error, you switched your variables. Look where you have strRecipient & strEmail...

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


SEcondly, I believe you asked "write the email as normal".
Do you mean, edit it before sending...

Switch .Send with .Display