Sub Mail()
'This code checks how many cells are filled in on row 2, I use row 2 as I assume you have titles!
'It will ignore blanks, so if you have A2 filled in and H2 filled in the result will be 8
Dim LastCol As Long
Dim Counter As Integer
Dim OutApp As Object
Dim OutMail As Object
Dim strbody, carbon, subline, bodytxt, pthbody, BCCC As String
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
'Dim MyAttachments As outlook.attachments
carbon = ""
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
LastCol = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
'My sample email code (when I say mine - its built on Rons code!)
' >>>>>> If your column count is 1 (this is blank or actually 1) <<<<<<
If LastCol = 1 Then
strbody = "****** style=font-size:10pt;font-family:Arial>" & "Dear Bob one entry," & "<br> <br>" _
& "Reference: <b>" & "</b>. <br> "
subline = "Further Information Required"
'pthbdy = "\\PATH_TO_BODY_EMAIL_TEXT_IF_YOU_USE_THIS.htm"
'bodytxt = fso.OpenTextFile(pthbdy).ReadAll ' contents of above file
sensr = 1 'set the sensitivity level
On Error Resume Next
readr = True 'set the read receipt value
deliverr = False 'set delivered receipt value
ename = "YOUR PERSONS NAME"
carbon = ""
BCCC = "BCC NAME"
GoTo emailme
' >>>>>> If your column count is 2 <<<<<<
ElseIf LastCol = 2 Then
strbody = "****** style=font-size:10pt;font-family:Arial>" & "Dear Bob 2," & "<br> <br>" _
& "MORE INFOMATION: <b>" & "</b>. <br> "
subline = "Missing Information"
'pthbdy = "\\PATH_TO_BODY_EMAIL_TEXT_IF_YOU_USE_THIS.htm"
'bodytxt = fso.OpenTextFile(pthbdy).ReadAll ' contents of above file
sensr = 1
On Error Resume Next
readr = True
deliverr = False
ename = ""
carbon = ""
BCCC = ""
GoTo emailme
ElseIf LastCol > 2 Then
MsgBox "whoa!, you have 3 columns filled in....go easy on the data entry!"
Exit Sub
emailme:
With OutMail
.To = ename
.cc = carbon
.BCC = ""
.Subject = subline
.HTMLBody = strbody & bodytxt & "<br>" & .HTMLBody
.Importance = 2
.ReadReceiptRequested = readr
.OriginatorDeliveryReportRequested = deliverr
.Sensitivity = sensr
.SentOnBehalfOfName = """EMAILNAMETODISPLAY""<ACTUALEMAILADDRESS.COM>"
'>>>>> Add attachments if you want per type <<<<<
'If LastCol = 1 Then
'.attachments.Add "\\YOURFILELOCATION\YOURFILE.pdf"
' End If
'If LastCol = 2 Then
'.attachments.Add "\\YOURFILELOCATION\YOURFILE.DOC"
'End If
.Display 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Else
End If
End Sub