Create email which body depends on data

[excelush123]

Hi,

I am quite new to vba and was hoping to someone could help me. I have an excel sheet in which I fill in the cells with data. I want a vba that when clicked generates an email. That part I know how to do. What I need help is, as follows: The excel sheet can be filled with 3 to 10 pieces of data(A,B,C,D etc). I want the vba to realise how many pieces of data there are and before each one say option 1, option 2 etc

Any help would be appreciated

 

[bugmonsta]

Hi,

Heres an example - I have a spreadsheet with titles in row 1, so the code looks at row 2 - counts how many columns are filled in and then creates different emails.... I hope it might help you out...

I've included 3 column count (the last just being a message), but you can add as many as you want

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