Advertisement
Guest User

Untitled

a guest
Oct 23rd, 2016
87
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.44 KB | None | 0 0
  1. Sub Plan()
  2. Dim OutApp As Object
  3. Dim OutMail As Object
  4. Dim sh As Worksheet
  5. Dim cell As Range
  6. Dim FileCell As Range
  7. Dim rng As Range
  8.  
  9. With Application
  10. .EnableEvents = False
  11. .ScreenUpdating = False
  12. End With
  13.  
  14. Set sh = Sheets("Sheet1")
  15.  
  16. Set OutApp = CreateObject("Outlook.Application")
  17. For Each cell In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)
  18.  
  19. 'Enter the path/file names in the C:Z column in each row
  20. Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
  21.  
  22. If cell.Value Like "?*@?*.?*" And _
  23. Application.WorksheetFunction.CountA(rng) > 0 Then
  24. Set OutMail = OutApp.CreateItem(0)
  25.  
  26.  
  27.  
  28. With OutMail
  29. .SentOnBehalfOfName = """SenderName"" <dan_alex@yahoo.com>"
  30. .To = cell.Value
  31. .cc = Range("D1")
  32.  
  33. .Subject = "Plan for" & Range("G1")
  34. .HTMLBody = "<font size=""2"" face=""Arial"">" & _
  35. "Dear " & [B1].Value & vbNewLine & vbNewLine & "<p>Attached is the plan.</br>"
  36.  
  37. For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
  38. If Trim(FileCell) <> "" Then
  39. If Dir(FileCell.Value) <> "" Then
  40. .Attachments.Add FileCell.Value
  41. End If
  42. End If
  43. Next FileCell
  44.  
  45. .Send 'Or use .Display
  46. End With
  47.  
  48. Set OutMail = Nothing
  49. End If
  50. Next cell
  51.  
  52. Set OutApp = Nothing
  53. With Application
  54. .EnableEvents = True
  55. .ScreenUpdating = True
  56. End With
  57. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement