snuffnchess
Board Regular
- Joined
- May 15, 2015
- Messages
- 68
- Office Version
- 365
- Platform
- Windows
I need to come up with a work around for IF an attachment is unable to be located that the script will move on to the next email and then place emdata.Range("A"&r) value on erdata.Range - Column C... and then just start from row 2 going down.
I was dumb when i created the error handling for if "sfile ="" because that just cannot happen in this code. So instead somehow need to make it so that if emAttach file does not exist....... How would this go about getting done?
I was dumb when i created the error handling for if "sfile ="" because that just cannot happen in this code. So instead somehow need to make it so that if emAttach file does not exist....... How would this go about getting done?
VBA Code:
Option Explicit
Public sfolder As String
Public sfile As String
Sub SendMail()
Dim objOutlook As Object
Dim objMail As Object
Dim emTo As String
Dim emRep As String
Dim emCC
Dim emSubject As String
Dim emBody As String
Dim emAttach As String
Dim emdata As Worksheet
Dim ob As Workbook
Dim r As Long
Dim emrng As Range
Set ob = ThisWorkbook
Set emdata = ob.Sheets("Email")
sfolder = emdata.Range("L1").Value
Set objOutlook = CreateObject("Outlook.Application")
For r = 2 To ActiveSheet.Range("A2").End(xlDown).Row
With ActiveSheet
Set emrng = emdata.Range(emdata.Cells(r, 5), emdata.Cells(r, 10))
.Range("D" & r).Value = WorksheetFunction.TextJoin(";", True, emrng)
emTo = .Range("D" & r)
If emTo = "" Then GoTo nextline
emCC = .Range("C" & r).Value
emRep = .Range("C" & r).Value
emSubject = .Range("A" & r).Value & " - DSO Report - " & Format(Now, "yyyy-mm-dd")
sfile = emdata.Range("A" & r).Value & ".xlsx"
If sfile = "" Then GoTo nextline
emAttach = sfolder & "\" & sfile
emBody = "<p>Hello <b>" & .Range("A" & r).Value & " team</b>,</p>" _
& "<p>Attached is this weeks DSO File with data from ::startdate:: to ::enddate::</p>" _
& "<p>Please let us know if you have any questions.</p>" _
& "<p>Team " & .Range("B" & r).Value & "<br>" & .Range("c" & r).Value & "</a></p>"
End With
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = emTo
.cc = emCC
.ReplyRecipients.Add emRep
.Subject = emSubject
.HTMLBody = "<html><head></head><body>" & emBody & "</body></html>"
.Attachments.Add emAttach
.Display
'.Send ' If you want to send it without clicking
End With
nextline:
Next
End Sub
