Automatically send .jpeg email when cell is populated

Shanecaolan

New Member
Joined
May 4, 2022
Messages
1
Office Version
  1. 365
Platform
  1. Windows
Hi there,
I am trying to work out a macro for automatically emailing a push notification / update to a customer which will contain a .jpeg image from the spreadsheet. Ideally, I want the email to send once data is entered to column O. The email address for the customer is contained in column D and I want the .jpeg to be a picture of the data from column A to N of just the single row that has had the cell in column O populated. I don't mind if the trigger data in column O is alphabetic or numeric, whatever is easiest. Also, is it possible to have it so that when O6 is populated, the address from D6 will be used and data from A6-N6 sent, then when O7 is populated, the address is pulled from D7 and cells A7-N7 sent and it will continue down for each row?. The email addresses will mostly be different in each row. So far, I have the below worked out / stolen. A6 as referenced in the subject and body text is the PO number to be included. Any help would be greatly appreciated! Thanks in advance.

VBA Code:
Sub Mail_small_Text_And_JPG_Range_Outlook()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim MakeJPG As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Dear " & Range("C6") & "<br><br>" & _
        "This is a push notification for " & Range("A6") & "<br><br>" & _
        "Please see the below details including the RFS risk level." & "<br><br>"

    MakeJPG = CopyRangeToJPG("BAU Tracker", "A6:N6")

    If MakeJPG = "" Then
        MsgBox "Something went wrong, we can't create the mail"
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Exit Sub
    End If

    On Error Resume Next
    With OutMail
        .To = Range("D6")
        .CC = ""
        .BCC = ""
        .Subject = Range("A6") & " Push Notification"
        .Attachments.Add MakeJPG, 1, 0
        .HTMLBody = "<html><p>" & strbody & "</p><img src=""cid:NamePicture.jpg"" width=1750 height=20></html>"
        .Display
    End With
    On Error GoTo 0

    Kill MakeJPG

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub



Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String
    Dim PictureRange As Range

    With ActiveWorkbook
        On Error Resume Next
        .Worksheets(NameWorksheet).Activate
        Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
        
        If PictureRange Is Nothing Then
            MsgBox "Sorry this is not a correct range"
            On Error GoTo 0
            Exit Function
        End If
        
        PictureRange.CopyPicture
        With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
            .Activate
            .Chart.Paste
            .Chart.Export Environ$("temp") & Application.PathSeparator & "NamePicture.jpg", "JPG"
        End With
        .Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
    End With
    
    CopyRangeToJPG = Environ$("temp") & Application.PathSeparator & "NamePicture.jpg"
    Set PictureRange = Nothing
End Function
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

Forum statistics

Threads
1,223,911
Messages
6,175,326
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top