MS Access Module to Send Email

[tuktuk]

Hey there,

I currently have code that sends an email that i found online. It looks to a txt file for the content of the body of the mail. This is currently functioning.

I am trying to add a Hyperlink to the body of the email.....but unfortunatly i cannot figure out how to add the hyperlink to a txt file......or would it be easier to add the link to the vba code that creates the msg.

thanks
tuk

Public Sub SendEMail()
 
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
 
Set fso = New FileSystemObject
 
' First, we need to know the subject.
' We can??t very well be sending around blank messages...
 
Subjectline$ = "DATA IS READY"
'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 Sub
End If
 
' Now we need to put something in our letter...
Const FILE_PATH As String = "C:\MyPath\"
Dim FullPath As String
strFullPath = FILE_PATH
Dim strDate As String
Dim strReport As String

strFile = strFullPath & "MYFILE.xlsm"
 
BodyFile$ = "C:\MYEMAILBODYPATH\EmailBody.txt"

'InputBox$("Please enter the filename of the body of the message.", _
"We Need A Body!")
' 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 Sub
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 Sub
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
 
' Now, we open Outlook for our own device..
Set MyOutlook = New Outlook.Application
 
' Set up the database and query connections
 
Set db = CurrentDb()
 
'gather distroList
Set MailList = db.OpenRecordset("qry_MyEmailAddresses")
 
' 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.
' and we add them to the RECIPIENTS collection
 
Set MyMail = MyOutlook.CreateItem(olMailItem)
 
Do Until MailList.EOF
 
' This creates the e-mail
' This addresses it
 
 MyMail.Recipients.Add MailList("Email")
 
'This gives it a subject
MyMail.Subject = Subjectline$
 
'This gives it the body
MyMail.Body = MyBodyText
 

'And on to the next one...
MailList.MoveNext
 
Loop
MyMail.Attachments.Add strFile, olByValue, 1, "My Displayname"
 
MyMail.Send

'Cleanup after ourselves
Set MyMail = Nothing
Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
 
End Sub