This code was found on this forum so credit to the originator.
My code links in the attachment always stored in the c:\temp directory along with the body text.
Public Function SendeMailAttachment()
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
'
Dim intMailcount As Integer
Dim iResponse As Integer
Dim strAttachmentFlag As String
Dim FileAttachment As String
intMailcount = 0
Set fso = New FileSystemObject
' First, we need to know the subject. We can't very well be sending around blank messages...
Subjectline$ = InputBox$("Please enter the subject line for this mailing.", "We Need A Subject Line!")
' If there's no subject, call it a day.
If Subjectline$ = "" Then
MsgBox "No subject line, no message." & vbNewLine & vbNewLine & "Quitting...", vbCritical, "e-Mail Merger"
Exit Function
End If
'
' Now we need to put something in our letter...
'BodyFile$ = InputBox$("Please enter the filename of the body of the message.", "We Need A Body!")
'
'or Replace line above with a default text file
BodyFile$ = "c:\temp\emailbody.txt"
'
' If there's nothing to say, call it a day.
If BodyFile$ = "" Then
MsgBox "No body, no message." & vbNewLine & vbNewLine & "Quitting...", vbCritical, "I Ain't Got No-Body!"
Exit Function
End If
' 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 = fs
penTextFile(BodyFile, ForReading, False, TristateUseDefault)
'and read it into a variable.
MyBodyText = MyBody.ReadAll
' and close the file.
MyBody.Close
'
'Now we check for Attachments
iResponse = MsgBox("Is there an attachment?", vbYesNo + vbQuestion, "Is there an Attachment?")
If iResponse = 6 Then
'strAttachmentFlag = "YES" LATER
'
' Where is it?
FileAttachment$ = InputBox$("What is the precise file path?" & vbNewLine & vbNewLine & _
"example c:\temp\myfile.doc", "Where is the file to be attached?")
'
' Is it there?
If FileAttachment$ = "" Then
MsgBox "You did not enter a file" & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "NO file entered"
Exit Function
End If
'
'Now check that the file exists
'
If fso.FileExists(FileAttachment$) = False Then
'If fso.FileExists("c:\temp\myfile.txt") = False Then
'
MsgBox "The Attachment file is not where you say it is. " & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "Incorrect file path"
Exit Function
End If
strAttachmentFlag = "YES"
' All OK unless
Else
strAttachmentFlag = "NO"
End If
' Now, we open Outlook for our own device..
Set MyOutlook = New Outlook.Application
' Set up the database and query connections
Set db = CurrentDb()
Set MailList = db.OpenRecordset("EmailAddresses")
' now, this is the meat and potatoes.
' this is where we loop through our list of addresses, adding them to e-mails and sending them.
Do Until MailList.EOF
' This creates the e-mail
'
'New Counter'
intMailcount = intMailcount + 1
'
Set MyMail = MyOutlook.CreateItem(olMailItem)
' This addresses it
MyMail.To = MailList("e-mail")
'This gives it a subject
MyMail.Subject = Subjectline$
'This gives it the body
MyMail.Body = MyBodyText
'
Select Case strAttachmentFlag
Case "YES"
'MyMail.Attachments.Add "c:\temp\myfile.txt", olByValue, 1, "file from Yourname"
Case Else
' Do nothing
End Select
'
'This sends it!
MyMail.Send
'And on to the next one...
MailList.MoveNext
Loop
'
'NEW Message Box"
'
If intMailcount <= 0 Then
MsgBox "There were no Clients", vbExclamation, "Nothing has been sent!"
Else
MsgBox intMailcount & " e-mails have been sent to your Outbox", vbInformation, "e-mails have been sent"
End If
'
'Cleanup after ourselves
Set MyMail = Nothing
'Uncomment the next line if you want Outlook to shut down when its done.
'Otherwise, it will stay running.
'MyOutlook.Quit
Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
End Function
You should also look at this link too:
http://www.access-programmers.co.uk/forums/showthread.php?t=97854&highlight=email
Have fun. Its complex but works.
