Send an email, some with/without attachments

[Marlene.Sawhney]

Hi Everyone,

I'm trying to create a macro that will attach 2 or 3 documents to an
email. Right now, all recipients have 2 attachments, but a few of them
have a third attachment.

If there is no file in the 3rd attachment column then the macro doesn't
work. The answer is obvious, there is no file there.

Is there a way to tell the macro that if there is no attachment then
skip over it and attach nothing?

Here is the macro I have thus far.....I know I can just add another
line that says...

..Attachments.Add (CStr(ActiveCell.Offset(0, 7).Value)) but what do I do
if there is no attachment?

Thank you for all your help!


Sub newtest()

Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim olMyApp As Outlook.Application
Dim olMyEmail As Outlook.mailItem

Dim wd As Word.Application
Dim doc As Word.Document
Dim itm As Object
Dim ID As String
Dim body As String
Dim blnWeOpenedWord As Boolean
'On Error Resume Next

'Initialize Word
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
blnWeOpenedWord = True
End If

'Initialize Workbook
Set wkb = ThisWorkbook
Set wks = wkb.Worksheets("Sheet1")
Set rng = wks.Range("A2")

'Initialize Outlook
Set olMyApp = New Outlook.Application
Set olMyEmail = olMyApp.CreateItem(olMailItem)

'Start Range at Cell A2
Range("A2").Select

'Loop through all rows in spreadsheet
Do Until IsEmpty(ActiveCell)
Set doc = wd.Documents.Open(CStr(ActiveCell.Offset(0,
2).Hyperlinks.Item(1).Address))

'Dim mailItm As Outlook.mailItem
'Set mailItm = Outlook.olMailItem
'mailItm.Attachments.add(

Set itm = doc.MailEnvelope.Item
doc.MailEnvelope.Introduction = ActiveCell.Offset(0, 4).Value
With itm
.To = ActiveCell.Text
.CC = ActiveCell.Offset(0, 5).Text
.Subject = ActiveCell.Offset(0, 1).Text
.Attachments.Add (CStr(ActiveCell.Offset(0, 3).Value))
.Attachments.Add (CStr(ActiveCell.Offset(0, 6).Value))
.Save
End With
Set itm = Nothing

'Set itm = Application.Session.GetItemFromID(ID)
'itm.Send
doc.Close wdDoNotSaveChanges
If blnWeOpenedWord Then
wd.Quit
End If



MsgBox "You successfully sent the email & attachment."

Set olMyApp = Nothing
Set olMyEmail = Nothing

Set doc = Nothing
Set itm = Nothing
Set wd = Nothing

End Sub