none
VBA- excel email reminders help RRS feed

  • Question

  • Hi all!

    I currently have an excel that produces email reminders based on each row`s due date which sends them out whenever the excel log is opened. I plan to use a task scheduler to open the log automatically on every 8am. However problem surfaces when I want to open the log solely for editing purposes. 

    Hope someone could provide me with a solution, maybe by adding time to the formula/code such that emails will only be sent once or only be sent between 8am - 830am.

    Am open to any other solutions as well! (:

    Format of the excel:

    Current Code (have replaced terms with non-confidential words) :

    Dim Bcell As Range
    Dim iTo, iSubject, iBody As String
    Dim ImportanceLevel As String
    
    Public Sub CheckDates()
        
        For Each Bcell In Range("D2", Range("D" & Rows.Count).End(xlUp))
    
            If Bcell.Offset(0, 5) <> Empty Then
    
                If DateDiff("d", Now(), Bcell) = 60 Then
    '               Debug.Print Bcell.Row & " 60"
                    iTo = Bcell.Offset(0, 5)
                    iSubject = "FIRST REMINDER - IN/SSGIFR no. " & Bcell.Offset(0, -3)
                    iBody = "Dear all," & vbCrLf & vbCrLf & _
                     "IN No. " & Bcell.Offset(0, -3) & " - " & Bcell.Offset(0, 1) & " (Batch: " & Bcell.Offset(0, 3) & ", Qty: " & _
                     Bcell.Offset(0, 2) & ")" & ", notified on " & Bcell.Offset(0, -1) & " will be due on " & _
                     Bcell & " . Please ensure that the consignment is closed by the due date and forward the closure reports ASAP." & _
                     vbCrLf & vbCrLf & "Thank you" & vbCrLf & vbCrLf & "Regards," & vbCrLf & "____________Department" & _
                     vbCrLf & "Company Pte Ltd."
                    
                    ImportanceLevel = olImportanceNormal
                    SendEmail
                End If
    
                If DateDiff("d", Now(), Bcell) = 30 Then
    '                Debug.Print Bcell.Row & " 30"
                     iTo = Bcell.Offset(0, 5)
                     iSubject = "SECOND REMINDER - IN/SSGIFR no. " & Bcell.Offset(0, -3)
                    iBody = "Dear all," & vbCrLf & vbCrLf & _
                     "IN No. " & Bcell.Offset(0, -3) & " - " & Bcell.Offset(0, 1) & " (Batch: " & Bcell.Offset(0, 3) & ", Qty: " & _
                     Bcell.Offset(0, 2) & ")" & ", notified on " & Bcell.Offset(0, -1) & " will be due on " & _
                     Bcell & " . Please ensure that the consignment is closed by the due date and forward the closure reports ASAP." & _
                     vbCrLf & vbCrLf & "Thank you" & vbCrLf & vbCrLf & "Regards," & vbCrLf & "______________Department" & _
                     vbCrLf & "Company Pte Ltd."
                     
                     ImportanceLevel = olImportanceNormal
                     SendEmail
                End If
    
                If DateDiff("d", Now(), Bcell) = 7 Then
    '               Debug.Print "ROW: " & Bcell.Row & " 7"
                    iTo = Bcell.Offset(0, 5)
                    iSubject = "FINAL REMINDER - IN/SSGIFR no. " & Bcell.Offset(0, -3)
                    iBody = "Dear all," & vbCrLf & vbCrLf & _
                     "IN No. " & Bcell.Offset(0, -3) & " - " & Bcell.Offset(0, 1) & " (Batch: " & Bcell.Offset(0, 3) & ", Qty: " & _
                     Bcell.Offset(0, 2) & ")" & ", notified on " & Bcell.Offset(0, -1) & " will be due on " & _
                     Bcell & " . Please ensure that the consignment is closed by the due date and forward the closure reports ASAP." & _
                     vbCrLf & vbCrLf & "Thank you" & vbCrLf & vbCrLf & "Regards," & vbCrLf & "____________ Department" & _
                     vbCrLf & "Company Pte Ltd."
                    
                    ImportanceLevel = olImportanceHigh
                    SendEmail
                End If
            End If
            
                iTo = Empty
                iSubject = Empty
                iBody = Empty
        Next Bcell
    
    End Sub
    
    Private Sub SendEmail()
    
        Dim OutApp As Object
        Dim OutMail As Object
        Dim strbody As String
    
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
    
        On Error Resume Next
            
        With OutMail
            .To = iTo
            .CC = "Department@company.com" & "; Colleague@company.com"
            .BCC = ""
            .Subject = iSubject
            .Body = iBody
            .Importance = ImportanceLevel
            .Send
        End With
    
        On Error GoTo 0
    
        Set OutMail = Nothing
        Set OutApp = Nothing
    
    End Sub
    
    

    Thursday, October 13, 2016 8:28 AM

All replies

  • Hi SakuraiHiro,

    According to your description, you could write a short vbscript which launches Excel, loads your workbook and uses Application.Run to run the macro. Have your scheduled task run the vbscript.

    For more information, please refer to Using Excel vba Macro to be run through Windows Schedule Task

    Disclaimer: This response contains a reference to a third party World Wide Web site. Microsoft is providing this information as a convenience to you. Microsoft does not control these sites and has not tested any software or information found on these sites; therefore, Microsoft cannot make any representations regarding the quality, safety, or suitability of any software or information found there. There are inherent dangers in the use of any software found on the Internet, and Microsoft cautions you to make sure that you completely understand the risk before retrieving any software from the Internet.

    Thanks for your understanding.
    Friday, October 14, 2016 2:19 AM
  • Hi David, thank you for your response!

    What im concern is, e.g. I scheduled the excel to be opened at 8am, but during the day, I have to add in new entries/edit the spreadsheet, emails will still be sent out (again) since the macro is currently triggered by simply having the spreadsheet opened.


    • Edited by SakuraiHiro Friday, October 14, 2016 7:43 AM
    Friday, October 14, 2016 7:42 AM
  • >>>I have to add in new entries/edit the spreadsheet, emails will still be sent out (again) since the macro is currently triggered by simply having the spreadsheet opened.

    According to your description, you could use Worksheet.Change event that occurs when cells on the worksheet are changed by the user or by an external link.

    Private Sub Worksheet_Change(ByVal Target as Range) 
        'your codes
    End Sub

    For more information, please refer to Worksheet.Change Event (Excel)

    Thanks for your understanding.
    Monday, October 17, 2016 6:48 AM
  • Apologies I have only gotten to know about VBA very recently and am definitely still a novice.

    I have read through the link but have no idea how it can help with the problem. If you don`t mind, could you elaborate on it?

    Monday, October 17, 2016 8:11 AM
  • Hi, I have resolved the problem with an alternate method which is to add

    If Now() - Bcell.Offset(0, 6) > 0.95 Then

    at the start of the code and,

    Bcell.Offset(0, 6) = Now()

    at the end of each sendEmail

    such that when emails are first sent, it will produce a timestamp at Bcell.Offset(0,6). and the next time there is a prompt to send the same email, it will check if the last sent date was within 0.95days from the time last sent. If within the time/date, email will not be sent.

    However, a slightly off topic question:

    How do I change the font and colour  of the email body (specifically the due date the email pluck from the excel). Since it is expressed as  Bcell instead of " text ", I couldn`t use method like <B> </B> or etc.

    I would like to bold and change it to red font.

    Tuesday, October 18, 2016 7:35 AM
  • >>>How do I change the font and colour  of the email body (specifically the due date the email pluck from the excel). Since it is expressed as  Bcell instead of " text ", I couldn`t use method like <B> </B> or etc.

    According to your description, you could use MailItem.HTMLBody property to set a String representing the HTML body of the specified item. 

    For more information, click here to refer to MailItem.HTMLBody Property (Outlook)

    Thanks for your understanding.
    Tuesday, October 18, 2016 9:28 AM
  • Hi,

    So do I copy and paste

    .BodyFormat = olFormatHTML 
     
     .HTMLBody = _ 
     
     "<HTML><BODY>Enter the message text here. </BODY></HTML>" 

    right below the part of my code which says:

    With OutMail
            .To = iTo
            .CC = "abc@GMAIL.COM" & ";xyz@LIVE.COM.SG"
            .BCC = ""
            .Subject = iSubject
            .Body = iBody
            

    If so, I have done so, but the part I wanted to quote isn`t in quotation marks as shown in the example in the link. If possible, could you guide me along?

    Another matter (apologies in advance for all the numerous prompts),

    how do I get the macros to work on multiple sheets in the same workbook? I tried having the whole chunk of code in the "ThisWorkbook" page but it will only run when I manually run it instead of running immediately upon opening the excel.


    • Edited by SakuraiHiro Tuesday, October 18, 2016 3:16 PM
    Tuesday, October 18, 2016 2:37 PM
  • For the HTML part, I got it to work! thanks!! But now that it is in HTML, the "vbCrLf" to make spacing have been ignored and now its just one whole sentence.

              iBody = "Dear all," & vbCrLf & vbCrLf & _
              "IN/SSGIFR No. " & Bcell.Offset(0, -2) & " - " & Bcell.Offset(0, 1) & " (Batch: " & Bcell.Offset(0, 3) & ", Qty: " & _
              Bcell.Offset(0, 2) & ")" & ", notified on " & Bcell.Offset(0, -1) & " will be due on<b><FONT COLOR=#ff0000> " & _
              Bcell & "</font></b>." & vbCrLf & "Please ensure that the consignment is closed by the due date and forward the closure reports ASAP." & _
              vbCrLf & vbCrLf & "Thank you" & vbCrLf & vbCrLf & "Regards," & vbCrLf & "YYY Department" & _
              vbCrLf & "XXX Pte Ltd."
    How the email looks like:

    Dear all, IN/SSGIFR No. IN160002 - mouse (Batch: WEN29F, Qty: 2676 x 28), notified on 19/11/2014 will be due on18/11/2016. Please ensure that the consignment is closed by the due date and forward the closure reports ASAP. Thank you Regards, YYY Department XXX Pte Ltd.


    But still have no idea how to get my macro to work on all sheets





    • Edited by SakuraiHiro Wednesday, October 19, 2016 1:38 AM
    Wednesday, October 19, 2016 1:23 AM
  • >>>But now that it is in HTML, the "vbCrLf" to make spacing have been ignored and now its just one whole sentence.

    According to your description, you could use <br/> instead of "vbCrlf".

    >>>But still have no idea how to get my macro to work on all sheets

    You could try to modify your code like below:
    Dim Current As Worksheet
    
    ' Loop through all of the worksheets in the active workbook.
    For Each Current In Worksheets
    
        ' Insert your code here.
        For Each Bcell In Current.Range("D2", Range("D" & Rows.Count).End(xlUp))
            'Insert your code here.
        Next Bcell
    
    Next Current

    For more information, please refer to Macro to Loop Through All Worksheets in a Workbook

    Thanks for your understanding.
    Wednesday, October 19, 2016 1:52 AM
  • The HTML works!! thanks a lot!

    As for the macro to run through all the sheet, do I create a new macro, then insert my current code in the

       ' Insert your code here.
    portion? Or do I write in in ThisWorkbook, or Sheet 1

    Wednesday, October 19, 2016 3:14 AM
  • >>>As for the macro to run through all the sheet, do I create a new macro, then insert my current code in the portion? Or do I write in in ThisWorkbook, or Sheet 1 

    According to your descriotion, you could create a new macro, then call existed macro, refer to like below:
    Sub Demo()
        Dim Current As Worksheet
    
        ' Loop through all of the worksheets in the active workbook.
        For Each Current In Worksheets
        
           Call CheckDates
        
        Next Current
    End Sub

    In addition since you are not familiar with Excel VBA, I suggest that you could start with Excel VBA reference

    Thanks for your understanding.
    Thursday, October 20, 2016 1:57 AM
  • Hi! I tried placing that code into a new module ( not sure if its right) but it pop up error saying: Compile Error: sub or Function not defined.

    Currently, I copy pasted the same of codes for the email reminders to each and every sheet, and the following:

    Private Sub Workbook_Open()
    
    Sheet1.CheckDates
    Sheet2.CheckDates
    Sheet3.CheckDates
    Sheet4.CheckDates
    Sheet5.CheckDates
    Sheet6.CheckDates
    Sheet7.CheckDates
    Sheet8.CheckDates
    
    End Sub
    

    in ThisWorkbook. It works but believe there is a efficient method.

    In the mean time, I will read up on the references.

    Edit: Have resolved the issues already! Thank you so much for your time for the past week! really appreciate your help :)

    Thursday, October 20, 2016 6:11 AM
  • Hi SakuaraiHiro,

    I am glad your issue has been resolved, and thanks for sharing.

    I would suggest you mark your reply as answer, and then others who run into the same issue would find the solution easily.

    Best Regards,

    Edward


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Friday, October 28, 2016 10:11 AM