C
cassels1
Hi, I have an Excel macro that creates a custom email in Outlook - uses
recipients' first and last names in the body of the message, provides
recipient-specific data, and attaches files for that particular person. All
of the data in the Outlook email is retrieved from an Excel spreadsheet.
When the directory path and/or file name for one or more attachments is
misspelled in the Excel spreadsheet (for example - file is spelled as C:\
FilName.doc instead of C:\FileName.doc) and the macro can't find the file, it
just ignores it, and the email is sent without the attachment(s). I would
like to install an error handling routine that can identify when an
attachment is not found, will create a folder called AttachmentErrors in my
Outlook Mailbox, and send the problem email to this, instead of sending the
email to the recipient.
Can someone help with this? A copy of the code is included below.
Note: I have never done any VBA programming before, but am an experienced
programmer in a number of other languages, so code is probably a little rough.
Also, I have included extensive comments because this application will
be distributed to several employees who are not technically oriented at all -
any suggestions to make code easier for them would be appreciated.
Debbie
-------------------------
Sub SendEmail()
' Define Outlook Application variables
Dim bStarted As Boolean
Dim oApp As Outlook.Application
Dim oMailItem As MailItem
Dim oAttach As Attachments
' Define placeholder variables
Dim Msg As String 'needed to compose message body
' Set up row counters
Dim r As Integer 'row counter
' _____________________________________________________________________
' Check to see if Outlook is running. If not, start Outlook
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
'______________________________________________________________________
' Note: The variable values are located as follows:
' FirstName - Column 1 = Cell(r,1)
' LastName - Column 2 = Cell(r,2)
' Email - Column 3 = Cell(r,3)
' Phone - Column 4 = Cell(r,4)
' Extension - Column 5 = Cell(r,5)
' Subject - Column 6 = Cell(r,6)
' Attach1 - Column 7 = Cell(r,7)
' Attach2 - Column 8 = Cell(r,8)
' Attach3 - Column 9 = Cell(r,9)
' Attach4 - Column 10 = Cell(r,10)
' Attach5 - Column 11 = Cell(r,11)
' Select Rows
For r = 2 To 9 'Use data from Rows 2 through 9 in Excel spreadsheet
' Compose the message
' Note: The "vbCrLf" code inserts a carriage return or line break
' The ampersand symbol (&) is used for concatenation
Msg = "" 'This line clears out the old message contents. Keep
this!
Msg = "This is a test message. Please forward it back to Debbie and
delete. Thanks!"
Msg = Msg & vbCrLf &
"_____________________________________________________" & vbCrLf
' Dear FirstName LastName
Msg = Msg & "Dear " & Cells(r, 1) & " " & Cells(r, 2) & "," & vbCrLf
& vbCrLf
Msg = Msg & "Here is your contact information" & vbCrLf & vbCrLf
' Email address
Msg = Msg & "Email:" & " " & Cells(r, 3).Text & vbCrLf
' Phone Number
Msg = Msg & "Phone:" & " " & Cells(r, 4) & vbCrLf
' Extension
Msg = Msg & "Extension:" & " " & Cells(r, 5) & vbCrLf
Set oApp = New Outlook.Application
' Create Mail Item
Set oMailItem = oApp.CreateItem(olMailItem) 'Create a new Outlook email
oMailItem.Save
oMailItem.Recipients.Add Cells(r, 3) 'Identify Email Recipient
oMailItem.Subject = Cells(r, 6) 'Create Subject line
oMailItem.Body = Msg 'Create Body of message using Msg
template
Set oAttach = oMailItem.Attachments
oAttach.Add Trim(Cells(r, 7).Value), olByValue, 1 'Include Attach1
oAttach.Add Trim(Cells(r, 8).Value), olByValue, 1 'Include Attach2
oAttach.Add Trim(Cells(r, 9).Value), olByValue, 1 'Include Attach3
oAttach.Add Trim(Cells(r, 10).Value), olByValue, 1 'Include Attach4
oAttach.Add Trim(Cells(r, 11).Value), olByValue, 1 'Include Attach5
oMailItem.Send 'Send email
Set oAttach = Nothing 'Clear attachments
Set oMailItem = Nothing 'Clear current email content
oApp.Quit 'Quit this occurrence of Outlook
Set oApp = Nothing 'Clear Outlook application
Next r
End Sub
recipients' first and last names in the body of the message, provides
recipient-specific data, and attaches files for that particular person. All
of the data in the Outlook email is retrieved from an Excel spreadsheet.
When the directory path and/or file name for one or more attachments is
misspelled in the Excel spreadsheet (for example - file is spelled as C:\
FilName.doc instead of C:\FileName.doc) and the macro can't find the file, it
just ignores it, and the email is sent without the attachment(s). I would
like to install an error handling routine that can identify when an
attachment is not found, will create a folder called AttachmentErrors in my
Outlook Mailbox, and send the problem email to this, instead of sending the
email to the recipient.
Can someone help with this? A copy of the code is included below.
Note: I have never done any VBA programming before, but am an experienced
programmer in a number of other languages, so code is probably a little rough.
Also, I have included extensive comments because this application willbe distributed to several employees who are not technically oriented at all -
any suggestions to make code easier for them would be appreciated.
Debbie
-------------------------
Sub SendEmail()
' Define Outlook Application variables
Dim bStarted As Boolean
Dim oApp As Outlook.Application
Dim oMailItem As MailItem
Dim oAttach As Attachments
' Define placeholder variables
Dim Msg As String 'needed to compose message body
' Set up row counters
Dim r As Integer 'row counter
' _____________________________________________________________________
' Check to see if Outlook is running. If not, start Outlook
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
'______________________________________________________________________
' Note: The variable values are located as follows:
' FirstName - Column 1 = Cell(r,1)
' LastName - Column 2 = Cell(r,2)
' Email - Column 3 = Cell(r,3)
' Phone - Column 4 = Cell(r,4)
' Extension - Column 5 = Cell(r,5)
' Subject - Column 6 = Cell(r,6)
' Attach1 - Column 7 = Cell(r,7)
' Attach2 - Column 8 = Cell(r,8)
' Attach3 - Column 9 = Cell(r,9)
' Attach4 - Column 10 = Cell(r,10)
' Attach5 - Column 11 = Cell(r,11)
' Select Rows
For r = 2 To 9 'Use data from Rows 2 through 9 in Excel spreadsheet
' Compose the message
' Note: The "vbCrLf" code inserts a carriage return or line break
' The ampersand symbol (&) is used for concatenation
Msg = "" 'This line clears out the old message contents. Keep
this!
Msg = "This is a test message. Please forward it back to Debbie and
delete. Thanks!"
Msg = Msg & vbCrLf &
"_____________________________________________________" & vbCrLf
' Dear FirstName LastName
Msg = Msg & "Dear " & Cells(r, 1) & " " & Cells(r, 2) & "," & vbCrLf
& vbCrLf
Msg = Msg & "Here is your contact information" & vbCrLf & vbCrLf
' Email address
Msg = Msg & "Email:" & " " & Cells(r, 3).Text & vbCrLf
' Phone Number
Msg = Msg & "Phone:" & " " & Cells(r, 4) & vbCrLf
' Extension
Msg = Msg & "Extension:" & " " & Cells(r, 5) & vbCrLf
Set oApp = New Outlook.Application
' Create Mail Item
Set oMailItem = oApp.CreateItem(olMailItem) 'Create a new Outlook email
oMailItem.Save
oMailItem.Recipients.Add Cells(r, 3) 'Identify Email Recipient
oMailItem.Subject = Cells(r, 6) 'Create Subject line
oMailItem.Body = Msg 'Create Body of message using Msg
template
Set oAttach = oMailItem.Attachments
oAttach.Add Trim(Cells(r, 7).Value), olByValue, 1 'Include Attach1
oAttach.Add Trim(Cells(r, 8).Value), olByValue, 1 'Include Attach2
oAttach.Add Trim(Cells(r, 9).Value), olByValue, 1 'Include Attach3
oAttach.Add Trim(Cells(r, 10).Value), olByValue, 1 'Include Attach4
oAttach.Add Trim(Cells(r, 11).Value), olByValue, 1 'Include Attach5
oMailItem.Send 'Send email
Set oAttach = Nothing 'Clear attachments
Set oMailItem = Nothing 'Clear current email content
oApp.Quit 'Quit this occurrence of Outlook
Set oApp = Nothing 'Clear Outlook application
Next r
End Sub