Hi, I have written this code to send an email to a selected list, it works using the redemption code which will stop the Outlook access violation error. This is found at http://www.dimastr.com/redemption/ for those of you who what to try it. The coding takes the list creates an email puts the contents of a text file as the body of the email and then adds an attachments and off it goes. Fine it works a treat, but what if i want the body of the email to contain pics or some html code how can i add that to the body? Can anyone help.
My code so far is:
My code so far is:
Code:
Public Function TestEmailInvite()
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim OlApp As Outlook.Application
Dim olNamespace As Outlook.NameSpace
Dim OlFolder As Outlook.MAPIFolder
Dim OlMailItem As Outlook.MailItem
Dim objSafeMail As Redemption.SafeMailItem
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
Dim RecipName As String
Set fso = New FileSystemObject
Set db = CurrentDb()
'Get the data
Set MailList = db.OpenRecordset("QryCurrentUser")
Do Until MailList.EOF
RecipName = MailList("Name")
Set OlApp = CreateObject("Outlook.application") 'Create an instance of Redemption.SafeMailItem
Set olNamespace = OlApp.GetNamespace("MAPI")
Set OlFolder = olNamespace.GetDefaultFolder(olFolderInbox)
Set OlMailItem = OlFolder.Items.Add("IPM.note")
BodyFile$ = "c:\harrodianNewsLetter\AirHarrodsInvite.doc"
' Check to make sure the file exists...
If fso.FileExists(BodyFile$) = False Then
MsgBox "The body file isn't where you say it is. " & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "I Ain't Got No-Body!"
Exit Function
End If
' Since we got a file, we can open it up.
Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False, TristateUseDefault)
' and read it into a variable.
MyBodyText = MyBody.ReadAll
' and close the file.
MyBody.Close
'Give the email item its contents
With OlMailItem
.To = MailList("EmailAddress")
.Subject = "Invite"
.Body = "Dear " & RecipName & MyBodyText
.Attachments.Add "c:\E-Shot\Invitation.pdf"
End With
Set objSafeMail = New Redemption.SafeMailItem
objSafeMail.Item = OlMailItem
objSafeMail.Send
'instead of automaticially sending it
'Uncomment the next line to see the email
'And comment the " objSafeMail.Send" line above this.
'objSafeMail.Display
'And on to the next one...
MailList.MoveNext
Loop
'Cleanup after ourselves
Set objSafeMail = Nothing
Set OlMailItem = Nothing
Set OlFolder = Nothing
Set olNamespace = Nothing
Set OlApp = Nothing
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
MsgBox "All Emails have now been sent. "
End Function
