Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub Plan()
- Dim OutApp As Object
- Dim OutMail As Object
- Dim sh As Worksheet
- Dim cell As Range
- Dim FileCell As Range
- Dim rng As Range
- With Application
- .EnableEvents = False
- .ScreenUpdating = False
- End With
- Set sh = Sheets("Sheet1")
- Set OutApp = CreateObject("Outlook.Application")
- For Each cell In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)
- 'Enter the path/file names in the C:Z column in each row
- Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
- If cell.Value Like "?*@?*.?*" And _
- Application.WorksheetFunction.CountA(rng) > 0 Then
- Set OutMail = OutApp.CreateItem(0)
- With OutMail
- .SentOnBehalfOfName = """SenderName"" <dan_alex@yahoo.com>"
- .To = cell.Value
- .cc = Range("D1")
- .Subject = "Plan for" & Range("G1")
- .HTMLBody = "<font size=""2"" face=""Arial"">" & _
- "Dear " & [B1].Value & vbNewLine & vbNewLine & "<p>Attached is the plan.</br>"
- For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
- If Trim(FileCell) <> "" Then
- If Dir(FileCell.Value) <> "" Then
- .Attachments.Add FileCell.Value
- End If
- End If
- Next FileCell
- .Send 'Or use .Display
- End With
- Set OutMail = Nothing
- End If
- Next cell
- Set OutApp = Nothing
- With Application
- .EnableEvents = True
- .ScreenUpdating = True
- End With
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement