Auto generating emails from spreadsheet data

[ascott0169]

Hi,
I'm pretty new to VBA. i have a pretty good idea of what needs to be done but unsure how to string it all together and need some assistance.

I'm trying to create a VBA macro that will automatically use the data from a spreadsheet to pull data from the spreadsheet and send to corresponding email addresses
the macro will need to proceed row by row in the following manner.

any value = 2 in column B will create an email in my outlook application

emailitem.to will depend on the value of column K, this holds the supplier name. i know i need to insert an IF function here so that for example when K = apple it uses the email address for this supplier and when K = google it uses the address for that supplier instead etc. this data will be kept on a separate sheet within the excel file

emailitem.cc will be the same process as emailitem.to

emailitem.subject will be the following "PO (value of cell G on that row) - (date)"

emailitem.body will be "
Hello,



Please advise PO status"

I would also like to end the body of the email with my outlook email signature if possible

as stated this would have to run row by row executing for any rows with a B column value of 2
the number of rows would be dynamic changing day to day as the excel file is updated

Please review, acknowledge and confirm EDT

 

[breynolds0431]

Try the below.

Sub SendEMail()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("LeaveList") '<- Change sheet name to suit
Dim frow As Integer: frow = 2 'First row of data, change to suit
Dim xCol As Integer: xCol = 2 'Column (i.e.; col. B) to check for "2"
Dim lrow As Long: lrow = ws.Cells(ws.Rows.Count, xCol).End(xlUp).Row 'Determines last row in xCol
Dim c As Range

Dim oLook As Object, eMail As Object
Dim mName As String, rReason As String, rDate As Date, sName As String, sDept As String

'Finds email signature (update below where indicated)
Dim SigString As String, Signature As String
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\default.htm" '<- Update with your actual signature name
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

'Loops throuhg column B for occurances of "2" and generates email
For Each c In ws.Range(ws.Cells(frow, xCol), ws.Cells(lrow, xCol))
    If c.Value = 2 Then
        Set oLook = CreateObject("Outlook.Application")
        Set eMail = oLook.createItem(0)
        Dim supName As String: supName = ws.Cells(c.Row, 11).Value 'Supplier Name
        Dim POnum As String: POnum = ws.Cells(c.Row, 7).Value 'PO Value
        With eMail
            'Dependant on supName from column 11
            If supName = "" Then
                .To = ""
                .CC = ""
            Else
                .To = ""
                .CC = ""
            End If
            .Subject = "PO " & POnum & " - " & Date
            .HTMLBOdy = "Hello," & "<br>" & "<br>" & "Please advise PO status of " & _
                POnum & "." & "<br>" & "<br>" & Signature
            .display 'or change to .send
        End With
    End If
    Set eMail = Nothing
    Set oLook = Nothing
Next c

End Sub

Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function