Sending EMail With VBA
This page describes how to send email using VBA..
It is not difficult to add the ability to send email from your application. If all
you want to do is send the workbook, with just a subject but no content, you can
use ThisWorkbook.SendMail. However, if you want to include
text in the body of the message or include additional files as attachments, you need
some VBA code. The page describes a function called SendEmail
that wraps up the details in a nice, VBA-friendly function. You can download
the code file here.
The definition of the function is:
Function SendEMail(Subject As String, _
FromAddress As String, _
ToAddress As String, _
MailBody As String, _
SMTP_Server As String, _
BodyFileName As String, _
Optional Attachments As Variant) As Boolean
Where
Subject is the subject line of the email.
FromAddress is your email address.
ToAddress is the address to which the email will be sent. You can send a message to multiple
recipients by separating the email addresses with semi-colons.
MailBody is the text that is to be the body of the message. If you leave this blank and
BodyFileName names a text file, the body of the message will be all the text in the
file named by BodyFileName. If both BodyFileName and
MailBody are empty, the message is sent with no body.
SMTP_Server is the name of your outgoing mail server.
BodyFileName is the name of the text file that will be used as the
body of the message. If MailBody is not empty, this parameter is ignored
and the file is not used as the body. If both MailBody and BodyFileName
are not empty, the contents of MailBody is used as the body and BodyFileName
is ignored.
Attachments is a single file name or an array of file
names to attach to the message. If there is an error attaching one of the files,
processing continues with the rest of the files and the email will be sent.
The function returns True if successful or False if an error occurred.
The code requires a reference to Microsoft CDO for Windows 2000 Library. The typical file location of this
file is C:\Windows\system32\cdosys.dll . The GUID of this component is {CD000000-8B95-11D1-82DB-00C04FB1625D},
with Major = 1 and Minor = 0.
The code is shown below. You can download
the code file here.
Function SendEMail(Subject As String, _
FromAddress As String, _
ToAddress As String, _
MailBody As String, _
SMTP_Server As String, _
BodyFileName As String, _
Optional Attachments As Variant = Empty) As Boolean
Dim MailMessage As CDO.Message
Dim N As Long
Dim FNum As Integer
Dim S As String
Dim Body As String
Dim Recips() As String
Dim Recip As String
Dim NRecip As Long
If Len(Trim(Subject)) = 0 Then
SendEMail = False
Exit Function
End If
If Len(Trim(FromAddress)) = 0 Then
SendEMail = False
Exit Function
End If
If Len(Trim(SMTP_Server)) = 0 Then
SendEMail = False
Exit Function
End If
Recip = Replace(ToAddress, Space(1), vbNullString)
If Right(Recip, 1) = ";" Then
Recip = Left(Recip, Len(Recip) - 1)
End If
Recips = Split(Recip, ";")
For NRecip = LBound(Recips) To UBound(Recips)
On Error Resume Next
Set MailMessage = CreateObject("CDO.Message")
If Err.Number <> 0 Then
SendEMail = False
Exit Function
End If
Err.Clear
On Error GoTo 0
With MailMessage
.Subject = Subject
.From = FromAddress
.To = Recips(NRecip)
If MailBody <> vbNullString Then
.TextBody = MailBody
Else
If BodyFileName <> vbNullString Then
If Dir(BodyFileName, vbNormal) <> vbNullString Then
FNum = FreeFile
S = vbNullString
Body = vbNullString
Open BodyFileName For Input Access Read As #FNum
Do Until EOF(FNum)
Line Input #FNum, S
Body = Body & vbNewLine & S
Loop
Close #FNum
.TextBody = Body
Else
SendEMail = False
Exit Function
End If
End If
End If
If IsArray(Attachments) = True Then
For N = LBound(Attachments) To UBound(Attachments)
If Attachments(N) <> vbNullString Then
If Dir(Attachments(N), vbNormal) <> vbNullString Then
.AddAttachment Attachments(N)
End If
End If
Next N
Else
If Attachments <> vbNullString Then
If Dir(CStr(Attachments), vbNormal) <> vbNullString Then
.AddAttachment Attachments
End If
End If
End If
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_Server
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
On Error Resume Next
Err.Clear
.Send
If Err.Number = 0 Then
SendEMail = True
Else
SendEMail = False
Exit Function
End If
End With
Next NRecip
SendEMail = True
End Function
If you want to attach the workbook that contains the code, you need to make the file
read-only when you send it and then change access back to read-write. For example,
ThisWorkbook.Save
ThisWorkbook.ChangeFileAccess xlReadOnly
B = SendEmail( _
... parameters ...
Attachments:=ThisWorkbook.FullName)
ThisWorkbook.ChangeFileAccess xlReadWrite
|
This page last updated: 29-June-2012. |