Results 1 to 2 of 2

Mail based on dates

Threaded View

  1. #1
    Forum Contributor
    Join Date
    02-12-2018
    Location
    Clearwater, FL
    MS-Off Ver
    MS 365
    Posts
    217

    Mail based on dates

    I have a sheet called "TSA Request" that has a cell in F32 - where an agent puts an email address. Is it possible to have a code that states if the value in cell "F9" is less than 30 days then email to me & the value in cell F32. If F9 > 30 days then just email me. I have attached my workbook for any help you can provide & I have included the code that I am using for the email. Thank you in advance for any help you can provide.
    Public Function findEmployeeEmail(employeeName As String) As String
    Dim wsE         As Worksheet
    Dim fRng        As Range
    Dim eRec        As Long
    Dim firstName   As String
    Dim surName     As String
    Set wsE = Worksheets("Employees")
    
    firstName = Application.Trim(Left(employeeName, InStr(1, employeeName, " ")))
    surName = Application.Trim(Replace(employeeName, firstName, " "))
    With wsE.Range("B:B")
        Set fRng = .Find(What:=surName, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
        If Not fRng Is Nothing Then
            eRec = fRng.Row
            Do
                If fRng.Offset(0, 1).Value = firstName Then
                    findEmployeeEmail = wsE.Cells(fRng.Row, "U").Value
                    Exit Function
                           End If
                Set fRng = .FindNext(fRng)
            Loop While Not fRng Is Nothing And fRng.Row <> eRec
        End If
    End With
    End Function
    
    Public Sub Mail_Sheet_Outlook_Body()
    'Working in Excel 2000-2016
        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object
        Dim strbody As String
        Dim A As String
        Dim B As String
        Dim C As String
        Dim D As String
        Dim E As String
        Dim F As String
        Dim G As String
        Dim H As String
        Dim I As String
        Dim J As String
        Dim K As String
            
        A = Range("K23")
        B = Range("K24")
        C = Range("K25")
        D = Range("K26")
        E = Range("K27")
        F = Range("K28")
        G = Range("K29")
        H = Range("K30")
        I = Range("K31")
        J = Range("K32")
        K = Range("F17")
    
            With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
    
        Set rng = Nothing
        Set rng = Sheets("TSA Request").Range("A5:F31")
        
        
    
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
    
        On Error Resume Next
        With OutMail
            .To = "Location's Email"
            .CC = "[email protected]" & ";" & findEmployeeEmail(Range("F18").Value)
            .BCC = ""
            .Subject = "SSC Triage Assistance Request: " & Range("F5")
            .HTMLBody = RangetoHTML(Sheets("TSA Request").Range("A15:H15")) & RangetoHTML(Sheets("TSA Request").Range("A5:F14")) & RangetoHTML(Sheets("TSA Request").Range("A17:F31"))
            .Display   'or use .Display
        End With
        On Error GoTo 0
    
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    
        Set OutMail = Nothing
        Set OutApp = Nothing
    End Sub
    
    
    Public 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"
    
        '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
    Attached Files Attached Files

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Replies: 8
    Last Post: 07-20-2018, 11:52 AM
  2. Mail variable number of sheets in workbook based on VLOOKUP mail address
    By Tino XXL in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 08-08-2013, 08:44 AM
  3. Need Macros to send standard e-mail based on dates
    By jameslav2003 in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 01-16-2013, 11:10 AM
  4. [SOLVED] Auto filling dates based on previously entered dates and averaging numbers if dates equal
    By grambograham in forum Excel Formulas & Functions
    Replies: 1
    Last Post: 10-11-2012, 03:21 PM
  5. How to e-mail selected row and use e-mail address in a cell to send e-mail from excel
    By syedalamgir in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 12-27-2010, 02:15 AM
  6. Automatically send Mail for Due Dates from Excel
    By Kohinoor in forum Excel General
    Replies: 1
    Last Post: 03-20-2009, 12:10 PM
  7. E-mail notifications from Excel based on dates in speadsheets
    By DWBAUS in forum Excel Formulas & Functions
    Replies: 4
    Last Post: 05-23-2006, 12:45 PM

Tags for this Thread

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1