Macro to email based on Renewal Date
Page 1 of 4 123 ... LastLast
Results 1 to 10 of 34

Thread: Macro to email based on Renewal Date

  1. #1
    Board Regular
    Join Date
    Jun 2006
    Posts
    5,332
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Macro to email based on Renewal Date

    I have written code to email a recipient where "yes" appears in Col G. Where "Yes" Appears in Col "G", then I want the header as well as the rows "Yes" to be emailed to the recipient"


    I cannot get the code to do this


    See full code below





    Code:
     Sub Email_Reminder()
        Dim Email_Subject As String, Email_Send_To As String, Email_Body As String
        Dim Mail_Object As Object, Mail_Single As Variant
        Dim r As Long
        Dim cell As Range
    
    r = 2
    
    Do Until Trim(Cells(r, 7).Value) = ""
        Email_Subject = Sheets("Email").Range("B1")
        Email_Send_To = Cells(r, 6).Value
        Email_Body = Sheets("Email").Range("B2")
    
        For Each cell In Columns("G:G")
    
            If cell.Value = "Yes" Then
    
                On Error GoTo debugs
                Set Mail_Object = CreateObject("Outlook.Application")
                Set Mail_Single = Mail_Object.CreateItem(0)
                With Mail_Single
                    .Subject = Email_Subject
                    .To = Email_Send_To
                    .Body = Email_Body
                    .Display
                End With
    
            End If
    ResumeLoop:
        Next cell
    Loop
    
    Exit Sub
    debugs:
        If Err.Description <> "" Then MsgBox Err.Description
        GoTo ResumeLoop:
    End Sub

    See link for sample data


    https://www.dropbox.com/s/rjqsnkgpb8...Date.xlsm?dl=0

    It would be appreciated if someone could assist me

    I have also posted on link below

    https://www.excelforum.com/excel-pro...enew-date.html

  2. #2
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,669
    Post Thanks / Like
    Mentioned
    64 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Macro to email based on Renewal Date

    Try this
    Create a sheet called "Temp"

    Code:
    Sub Email_Reminder()
        Dim Email_Body As String, Mail_Single As Variant
        Dim c As Range, sht As Worksheet, rng As Range
        
        Set sht = Sheets("Temp")
        sht.Cells.ClearContents
        Rows(1).Copy sht.Rows(1)
        On Error Resume Next
        For Each c In Range("G2", Range("G" & Rows.Count).End(xlUp))
            If c.Value = "Yes" Then
                c.EntireRow.Copy sht.Rows(2)
                Set rng = sht.Range("A1:G2")
                Set Mail_Single = CreateObject("Outlook.Application").CreateItem(0)
                With Mail_Single
                    .Subject = Sheets("Email").Range("B1").Value
                    .To = Cells(c.Row, "F").Value
                    .HTMLBody = RangetoHTML(rng)
                    .Display
                End With
            End If
        Next
    End Sub
    
    
    Function RangetoHTML(rng As Range)
    ' Changed by Ron de Bruin 28-Oct-2006
    ' 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"
        TempFile = "C:\trabajo\temp.htm"
        'Copy the range and create a new workbook to past the data in
        rng.Copy
        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
            .Cells(1).Select
            Application.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            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, _
             HtmlType:=xlHtmlStatic)
            .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
        ts.Close
        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
    Regards Dante Amor

  3. #3
    Board Regular
    Join Date
    Jun 2006
    Posts
    5,332
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to email based on Renewal Date

    Thanks Dante

    I need the following changes.

    1) I need the body of the email to contain what is on sheet "Email"
    2) I need to email a separate sheet to each recipient where "Y" is in Col G

    Your assistance in this regard is most appreciated

  4. #4
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,669
    Post Thanks / Like
    Mentioned
    64 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Macro to email based on Renewal Date

    Quote Originally Posted by howard View Post
    Thanks Dante

    I need the following changes.

    1) I need the body of the email to contain what is on sheet "Email"
    2) I need to email a separate sheet to each recipient where "Y" is in Col G

    Your assistance in this regard is most appreciated

    I do not understand what sheets you have.
    You can explain with examples what datas you have in which sheet and what you want in the body of the mail.

    Please Note
    -----------------------
    One thing you must keep in mind when you ask a question in a forum... the people you are asking to help you know absolutely nothing about your data, absolutely nothing about how it is laid out in the workbook, absolutely nothing about what you want done with it and absolutely nothing about how whatever it is you want done is to be presented back to you as a result... you must be very specific about describing each of these areas, in detail, and you should not assume that we will be able to "figure it out" on our own. Remember, you are asking us for help... so help us to be able to help you by providing the information we need to do so, even if that information seems "obvious" to you (remember, it is only obvious to you because of your familiarity with your data, its layout and the overall objective for it).
    Last edited by DanteAmor; Jun 30th, 2019 at 12:24 PM.
    Regards Dante Amor

  5. #5
    Board Regular
    Join Date
    Jun 2006
    Posts
    5,332
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to email based on Renewal Date

    Hi Dante

    My Apologies for not being clear. I will get back to you tomorrow to explain step by step exactly what I require


    Regards


    Howard

  6. #6
    Board Regular
    Join Date
    Jun 2006
    Posts
    5,332
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to email based on Renewal Date

    Hi Dante

    The sheet containing all the data is "Renewals"

    The "Subject" for the email is in cell B1 on sheet "Email" and the body of the email is contained in B2 on sheet "Email"

    I would like a macro to generate send an Email where "Yes" appears in Col G on all sheets except "Renewals" & "Email"


    See updated file per link below

    https://www.dropbox.com/s/rjqsnkgpb8...Date.xlsm?dl=0


    I hope my explanation is clear and makes sense

  7. #7
    Board Regular
    Join Date
    Jun 2006
    Posts
    5,332
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to email based on Renewal Date

    Further to my post # 6 , I want the relevant sheet attached to the email
    Last edited by howard; Jun 30th, 2019 at 11:41 PM.

  8. #8
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,669
    Post Thanks / Like
    Mentioned
    64 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Macro to email based on Renewal Date

    Quote Originally Posted by howard View Post
    Further to my post # 6 , I want the relevant sheet attached to the email
    ok, try this new code

    Code:
    Sub Email_Reminder()
        Dim Mail_Single As Variant, c As Range, wFile As String
        Dim sh As Worksheet, shE As Worksheet, s As Worksheet, wb2 As Workbook
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Set sh = Sheets("Renewals")
        Set shE = Sheets("Email")
        On Error Resume Next
        For Each c In sh.Range("G2", Range("G" & Rows.Count).End(xlUp))
            If c.Value = "Yes" Then
                For Each s In Sheets
                    If UCase(s.Name) = UCase(sh.Cells(c.Row, "A").Value) Then
                        s.Copy
                        Set wb2 = ActiveWorkbook
                        wFile = ThisWorkbook.Path & "\" & s.Name & ".xlsx"
                        wb2.SaveAs wFile
                        Set Mail_Single = CreateObject("Outlook.Application").CreateItem(0)
                        With Mail_Single
                            .Subject = shE.Range("B1").Value
                            .To = sh.Cells(c.Row, "F").Value
                            .Body = shE.Range("B2").Value
                            .Attachments.Add wFile
                            .Display
                        End With
                        wb2.Close False
                        Exit For
                    End If
                Next
            End If
        Next
    End Sub
    Regards Dante Amor

  9. #9
    Board Regular
    Join Date
    Jun 2006
    Posts
    5,332
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to email based on Renewal Date

    Hi Dante

    Thanks very much. Code now works 100%

  10. #10
    Board Regular
    Join Date
    Jun 2006
    Posts
    5,332
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to email based on Renewal Date

    Dante I have one more request

    Once Email has been generated, I would like to insert "Emailed" in Col I in the same row as the items that were emailed

    It would be appreciated if you could incorporate this in your code if this is at all possible

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
  •