Attach Files to Email Message

[Dwight]

Does anyone know how I can attach several files to a
single email message?

When I click a button I want to be able to attach all the
files in a particular folder to and email message, and
automatically send it.

Thanks in advance!

Dwight

 

[Guest]

Dwight,

Give this function a try:

Function SendEmail(sSubject As String, sSendTo As String, sBodyText As
String, sFileAttachments As String, sDelimiter As String) As Boolean

'The sFileAttachments string can be delimited list of attachments to add,
each should be the fully qualified path and file name "C:\Temp\MyFile.xls"

'The delimiter argument specifies what is delimiting the list of file
attachments, i.e. "'" , ";" etc

'The sSendTo string can be delmited as well, but only with ; because that is
what Outlook likes/uses

'You must have a VBA reference to the Outlook object library

'This does not includ the functionality to test if files to attach really
exist. This could be added as noted below

On Error GoTo EH

Dim App As Outlook.Application

If OutLookIsOpen Then

Set App = GetObject(, "Outlook.Application")

Dim MailItm As MailItem

Dim sAttachments() As String

sAttachments() = Split(sFileAttachments, sDelimiter)

Dim i As Integer

Set MailItm = App.CreateItem(olMailItem)

MailItm.Subject = sSubject

MailItm.To = sSendTo

MailItm.Body = sBodyText

For i = 0 To UBound(sAttachments()) 'You chould check here if
each file exists before adding it.

MailItm.Attachments.Add (sAttachments(i))

Next i

MailItm.send

SendEmail = True

'Clean up the variables

Set App = Nothing

Set MailItm = Nothing

Else 'Outlook wasn't open, let the user know

MsgBox "MS Outlook is not currently running. Please open Outlook and try
again.", vbInformation, "Error..."

SendEmail = False

End If

Exit Function

EH:

If Err.Number = 287 Then

MsgBox "You choose not to send an email to '" & sSendTo & "'" & vbCrLf &
"with the subject '" & sSubject & "' including the following attachments: " &
vbCrLf & sFileAttachments, vbExclamation, "No Email Sent!"

Else

MsgBox "An error occured while trying send an email to '" & sSendTo &
"'" & vbCrLf & "with the subject '" & sSubject & "' including the following
attachments: " & vbCrLf & sFileAttachments, vbExclamation, "No Email Sent!"

End If

SendEmail = False

End Function

Function OutLookIsOpen() As Boolean
On Error GoTo EH
Dim App As Object
Set App = GetObject(, "Outlook.Application")
OutLookIsOpen = True
Exit Function
EH:
OutLookIsOpen = False
End Function

Good Luck!!!!!

JP
**************************************************

 

[Dwight]

Thank you very much!

-----Original Message-----
Dwight,

Give this function a try:

Function SendEmail(sSubject As String, sSendTo As String, sBodyText As
String, sFileAttachments As String, sDelimiter As String) As Boolean

'The sFileAttachments string can be delimited list of attachments to add,
each should be the fully qualified path and file name "C:\Temp\MyFile.xls"

'The delimiter argument specifies what is delimiting the list of file
attachments, i.e. "'" , ";" etc

'The sSendTo string can be delmited as well, but only with ; because that is
what Outlook likes/uses

'You must have a VBA reference to the Outlook object library

'This does not includ the functionality to test if files to attach really
exist. This could be added as noted below

On Error GoTo EH

Dim App As Outlook.Application

If OutLookIsOpen Then

Set App = GetObject(, "Outlook.Application")

Dim MailItm As MailItem

Dim sAttachments() As String

sAttachments() = Split(sFileAttachments, sDelimiter)

Dim i As Integer

Set MailItm = App.CreateItem(olMailItem)

MailItm.Subject = sSubject

MailItm.To = sSendTo

MailItm.Body = sBodyText

For i = 0 To UBound(sAttachments()) 'You chould check here if
each file exists before adding it.

MailItm.Attachments.Add (sAttachments(i))

Next i

MailItm.send

SendEmail = True

'Clean up the variables

Set App = Nothing

Set MailItm = Nothing

Else 'Outlook wasn't open, let the user know

MsgBox "MS Outlook is not currently running. Please open Outlook and try
again.", vbInformation, "Error..."

SendEmail = False

End If

Exit Function

EH:

If Err.Number = 287 Then

MsgBox "You choose not to send an email to '" & sSendTo & "'" & vbCrLf &
"with the subject '" & sSubject & "' including the following attachments: " &
vbCrLf & sFileAttachments, vbExclamation, "No Email Sent!"

Else

MsgBox "An error occured while trying send an email to '" & sSendTo &
"'" & vbCrLf & "with the subject '" & sSubject & "' including the following
attachments: " & vbCrLf & sFileAttachments,

vbExclamation, "No Email Sent!"