Results 1 to 3 of 3
  1. #1
    New Lounger
    Join Date
    Sep 2014
    Posts
    1
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Email Alerts From Spreadsheet

    Hi,

    I was wondering if anyone could help me. I am looking to setup email alerts for different email accounts on a single spreadsheet for a specific date.

    Could someone possible help me with some coding on this.

    Any help would be appreciated.

  2. #2
    3 Star Lounger Supershoe's Avatar
    Join Date
    Apr 2014
    Location
    Austin, TX
    Posts
    252
    Thanks
    1
    Thanked 36 Times in 34 Posts
    Should get you started.
    Sub MailOnDate()
    If Date = "9/25/2014" Then
    MsgBox "Hi"
    'do your thing
    End If
    End Sub

  3. #3
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Tom,

    This code will only work with Outlook. When the workbook opens, it will check to see if Outlook is running. If not, you will be prompted to start Outlook then close and re-open the workbook. Once open, the code automatically checks the date in cell A1. If the date has not yet been reached or is the day of, an email will be immediately sent as a reminder to whatever email address you substitute in the code as well as a c.c. address. A message will indicate that a reminder was sent. If it is passed the date in Cell A1 then the book will open with no action performed.

    HTH,
    Maud

    Outlookpic.png

    Code:
    Private Sub Workbook_Open()
    '---------------------------------------------------
    'DECLARE AND SET VARIABLES
        On Error Resume Next
        Dim oOutlook As Object
        Dim OApp As Object
        Dim OMail As Object
        Dim strbody As String
        Set OApp = CreateObject("Outlook.Application")
        Set OMail = OApp.CreateItem(0)
    '---------------------------------------------------
    'CHECK IF OUTLOOK IS RUNNING
        Set oOutlook = GetObject(, "Outlook.Application")
        On Error GoTo 0
        If oOutlook Is Nothing Then
            MsgBox "Outlook is not open, open Outlook then close and re-open workbook"
            Exit Sub
        End If
    '---------------------------------------------------
    'CHECK DATE
        With Worksheets("Sheet1")
        If Date <= .Range("A1") Then
            Count = DateDiff("d", Date, .Range("a1"))
    '---------------------------------------------------
    'CREATE EMAIL BODY
            strbody = "REMINDER:" & vbNewLine & vbNewLine & _
                "There are " & Count & " days left before " & .Range("A1")
    '---------------------------------------------------
    'BUILD EMAIL
            On Error Resume Next
            With OMail
                .To = "johndoe@gmail.com" 'EMAIL ADDRESS IN QUOTES GOES HERE"
                .CC = "janedoe@gmail.com" 'EMAIL ADDRESS IN QUOTES GOES HERE
                .BCC = ""
                .Subject = "A Date Reminder"
                .Body = strbody
                .Send
            End With
        MsgBox "Reminder sent"
        End If
        End With
    '---------------------------------------------------
    'CLEANUP
            On Error GoTo 0
            Set OMail = Nothing
            Set OApp = Nothing
    End Sub

Posting Permissions

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