-----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,
