Results 1 to 3 of 3

Thread: Code Not sending email when worksheet range is changed
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Aug 2019
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default Code Not sending email when worksheet range is changed

    Private Sub Worksheet_Recalculate(ByVal Target As Range)
    '    In order for this macro to work you must
    '    reference the MS Outlook object library
        Dim rngChangeCells As Range
        On Error Resume Next    'set range to trigger email:
        Set rngChangeCells = Intersect(Target, Range("aa6:ac70"))
        On Error GoTo 0
        If Not rngChangeCells Is Nothing Then
        Call AutoEmail
        End If
    End Sub
    Sub AutoEmail()
    ' You need to use this module with the RangetoHTML subroutine.
    ' Working in Office 2000-2016
        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object
        Set rng = Nothing
        On Error Resume Next
        ' Only send the visible cells in the selection.
        Set rng = Sheets("Tower").Range("AA6:AC70").SpecialCells(xlCellTypeVisible) ' Change this
        On Error GoTo 0
        If rng Is Nothing Then
            MsgBox "The selection is not a range or the sheet is protected. " & _
                   vbNewLine & "Please correct and try again.", vbOKOnly
            Exit Sub
        End If
     With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = "" ' Change this to the email addresses you want to send to
            .CC = ""
            .BCC = ""
            .Subject = "Alert Notice Needed" ' Add in a subject
            .HTMLBody = RangetoHTML(rng)
            ' In place of the following statement, you can use ".Display" to
            ' display the e-mail message.
        End With
        On Error GoTo 0
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Set OutMail = Nothing
        Set OutApp = Nothing
    End Sub
    Function RangetoHTML(rng As Range)
    ' Working in Office 2000-2016
        Dim fso As Object
        Dim ts As Object
        Dim TempFile As String
        Dim TempWB As Workbook
        TempFile = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
        'Copy the range and create a new workbook to past the data in
        Set TempWB = Workbooks.Add(1)
        With TempWB.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial xlPasteValues, , False, False
            .Cells(1).PasteSpecial xlPasteFormats, , False, False
            Application.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            On Error GoTo 0
        End With
        'Publish the sheet to a htm file
        With TempWB.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             Filename:=TempFile, _
             Sheet:=TempWB.Sheets(1).Name, _
             Source:=TempWB.Sheets(1).UsedRange.Address, _
            .Publish (True)
        End With
        'Read all data from the htm file into RangetoHTML
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
        RangetoHTML = ts.readall
        RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                              "align=left x:publishsource=")
        'Close TempWB
        TempWB.Close savechanges:=False
        'Delete the htm file we used in this function
        Kill TempFile
        Set ts = Nothing
        Set fso = Nothing
        Set TempWB = Nothing
     End Function
    Last edited by RoryA; Aug 20th, 2019 at 08:53 AM. Reason: Code tags

  2. #2
    Board Regular jim may's Avatar
    Join Date
    Jul 2004
    Roanoke, VA
    Post Thanks / Like
    3 Post(s)
    0 Thread(s)

    Default Re: Code Not sending email when worksheet range is changed

    Have you tries STEPPING-THROUGH the code (using the F8 Key) and during the process determining what happens (as you go).
    Is an Error Produced after you run the code, or does just "nothing happen"?
    To display your spreadsheet data use either MrExcel HTML Maker or Excel Jeanie

  3. #3
    Board Regular MARK858's Avatar
    Join Date
    Nov 2010
    Southern England
    Post Thanks / Like
    1 Post(s)
    2 Thread(s)

    Default Re: Code Not sending email when worksheet range is changed

    Try running the macro below and see if it makes a difference.

    Sub xxxx()
    Application.EnableEvents = True
    End Sub
    Also beforehand go Tools - Reset.
    Test VBA on a copy of your data (remember you can't normally reverse the action)

    Please follow the forum Rules and Guidelines & please use Code tags around your code i.e. [CODE]your code[/CODE]

    To post a screenshot try one of these links
    MrExcel HTML Maker, RoryA addin (Win & Mac) or Borders-Copy-Paste

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts