1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Solved Help with Excel sending automated email

Discussion in 'Business Applications' started by muppo2000, Jun 19, 2017.

Thread Status:
Not open for further replies.
  1. muppo2000

    muppo2000 Thread Starter

    Joined:
    Jun 19, 2017
    Messages:
    2
    Hi Guys,

    I'm new on the forum so wanted to firstly say a quick Hi!!
    But I wonder if you can help as I just cant get an issue solved and I'm sure you wizards of the Excel world can help me.
    I am trying to get a spreadsheet to send automated email based on a trigger to say If todays date is within 7 days of the due date Then email a list of people in recorded another cell range

    I found the following thread which looks really useful but I am getting constant errors when I try to apply the principle to my sheet.
    https://forums.techguy.org/threads/...ue-date-reminder-based-on-excel-file.1129238/

    I have table which starts in Cell B3.. (Headings in row 2)
    Column A is Blank
    Column B is Date Raised - this isnt used for anything
    Column C is the Topic Of Work
    Column D is the Notes from the meeting
    Column E is the names of who the topics are assigned to
    Column F contains the list of Email address to send that topic to
    Column G is the due date (which I want to email out 7 days prior to)
    and Column H is where the macro should make that it has sent the emails

    The code I have tried is as follows... but I continually get a "Subscript out of range error"
    Sub eMail()
    Dim lRow As Integer
    Dim i As Integer
    Dim toDate As Date
    Dim toList As String
    Dim eSubject As String
    Dim eBody As String
    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    End With
    Sheets(OpenActions).Select
    lRow = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 3 To lRow
    toDate = Replace(Cells(i, 7), ".", "/")
    If Left(Cells(i, 8), 4) <> "Mail" And toDate - Date <= 7 Then
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    toList = Cells(i, 6) 'gets the recipient from col F
    eSubject = "Action Topic " & Cells(i, 3) & " is due on " & Cells(i, 7)
    eBody = "Dear " & Cells(i, 5) & vbCrLf & vbCrLf & "Please update your project status. Minutes from last meeting:" & Cells(i, 4)

    On Error Resume Next
    With OutMail
    .To = toList
    .CC = ""
    .BCC = ""
    .Subject = eSubject
    .Body = eBody
    .bodyformat = 1
    .Display ' ********* Creates draft emails. Comment this out when you are ready
    '.Send '********** UN-comment this when you are ready to go live
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    Cells(i, 8) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
    End If
    Next i
    ActiveWorkbook.Save
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    End With
    End Sub


    Can anyone point me in the right direction as to why this is failing?

    Thanks in advance!!
     
  2. muppo2000

    muppo2000 Thread Starter

    Joined:
    Jun 19, 2017
    Messages:
    2
    Not to worry... I've sorted it.

    Thanks
     
As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Tags:
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1191722

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice