Results 1 to 7 of 7

Thread: Schedule email from list
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member theboyscout's Avatar
    Join Date
    Nov 2012
    Posts
    24
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Schedule email from list

    Hello,

    I'm trying to create a script that would search a folder, find the last inserted spreadsheet, locate a field and if that field is > 0 send an email. And this is to be run weekly.

    F L O
    Descr Email Available_Spots
    60749 jon.snow@got.com 1


    I've scraped up a number of scripts from other users (unfortunately, I can't remember profile names to give them credit), see
    below
    :

    Sub Waitlist_Email()

    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LMD As Date
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody, SigString, Signature As String
    Dim MailAttachments As String
    Dim cell As Variant
    Dim GetBoiler As Object

    'Search for recent file in folder
    MyPath = “C:\Users\Desktop\Waitlist"
    If Right(MyPath, 1) <> “ \ ” Then MyPath = MyPath & “ \ ”
    MyFile = Dir(MyPath & “ * .xls”, vbNormal)
    If Len(MyFile) = 0 Then
    MsgBox “No files were found…”, vbExclamation
    Exit Sub
    End If
    Do While Len(MyFile) > 0
    LMD = FileDateTime(MyPath & MyFile)
    If LMD > LatestDate Then
    LatestFile = MyFile
    LatestDate = LMD
    End If
    MyFile = Dir
    Loop
    Workbooks.Open MyPath & LatestFile

    'If file is located send email
    Sheets("Sheet1").Select
    Range("A1").Select

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    'On Error GoTo cleanup
    For Each cell In Columns("L").Cells
    If cell.Value Like "?*@?*.?*" And _
    LCase(Cells(cell.Row, "O").Value) > "0" Then

    With Application.ActiveSheet
    MailAttachments = Cells(cell.Row, "E").Value
    End With


    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    With OutMail

    .To = cell.Value
    .Subject = "Enrollment available " & Cells(cell.Row, "F").Value 'Refer value from column F (Course Description)
    .HTMLBody = "" & _
    "Hello ," & Cells(cell.Row, "H") & ", " & ""
    " & _
    "Blah blah blah " & Cells(cell.Row, "F") & " blah blah blah " & Cells(cell.Row, "K") & " blah blah blah. " & ""
    " & _
    "
    " & _
    "
    " & _
    "
    " & _
    "**************************************************************************************************************" & "
    " & _
    "This is your signature file. It will always be 7 rows below whatever text you add in the macro code."
    'To add another line in your message or signature without skipping a row, end the line of text with
    'a quotation symbol and then an ampersand and an underscore. Ex: end of text." & _
    '.Attachments.Add MailAttachments
    .Display
    'Or use .Send

    End With

    On Error GoTo 0
    End If
    Next
    cleanup:
    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True

    End Sub

    I'm getting error message at
    " & _
    <strike></strike> and I can't figure out how to schedule to run weekly.

    Any help would be appreciated

  2. #2
    Board Regular Logit's Avatar
    Join Date
    Aug 2016
    Location
    United States
    Posts
    2,640
    Post Thanks / Like
    Mentioned
    34 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Schedule email from list

    .
    Once the macro has opened the newest file, what sheet and cell are you looking at for a value ?

    And, what value are you expecting in that cell, which will initiate the email sending ?

  3. #3
    New Member theboyscout's Avatar
    Join Date
    Nov 2012
    Posts
    24
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Schedule email from list

    It'll be Sheet1 and the cell I'll be looking at for a value is O. For each instance that in cell O there is a value greater than 0 then send an email

  4. #4
    Board Regular Logit's Avatar
    Join Date
    Aug 2016
    Location
    United States
    Posts
    2,640
    Post Thanks / Like
    Mentioned
    34 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Schedule email from list

    .
    This is part of the code :

    Code:
    Option Explicit
    
    
    Sub send_email_via_outlook()
    
    
    ' Tools - Refrence - Microsoft Outlook
    Dim olApp As New Outlook.Application
    Dim olMail As MailItem
    
    
    Set olMail = olApp.CreateItem(olMailItem)
        
        With olMail
            .To = "test@gmail.com"
            .CC = ""
            .Subject = "Send Range as table in outlook"  '<br> used to insert a line ( press enter)
            .HTMLBody = "Please find the table below <br><br> " & _
                        create_table(Sheet2.Range("A1").CurrentRegion) & _
                        "</Table><br> <br>Regards,<br><br>Afred E. Newman"
            .Display
            '.Send
        End With
    
    
    
    
    End Sub
    
    
    Function create_table(rng As Range) As String
    
    
    Dim mbody As String
    Dim mbody1  As String
    Dim i As Long
    Dim j As Long
    
    
    mbody = "<TABLE width=""75%"" Border=""1"", Cellspacing=""0""><TR>" ' configure the table
    
    
    'create Header row
    For i = 1 To rng.Columns.Count
        mbody = mbody & "<TD width=""100"", Bgcolor=""#A52A2A"", Align=""Center""><Font Color=#FFFFFF><b><p style=""font-size:18px"">" & rng.Cells(1, i).Value & "&nbsp;</p></Font></TD>"
    Next
    
    
    ' add data to the table
    For i = 2 To rng.Rows.Count
        mbody = mbody & "<TR>"
        mbody1 = ""
        For j = 1 To rng.Columns.Count
        mbody1 = mbody1 & "<TD><center>" & rng.Cells(i, j).Value & "</TD>"
        Next
        mbody = mbody & mbody1 & "</TR>"
    Next
    
    
    create_table = mbody
    End Function

    Examine the download to view the remainder of the code.

    Download workbook : https://www.amazon.com/clouddrive/sh...4r4DEHsj54m7XP

  5. #5
    New Member theboyscout's Avatar
    Join Date
    Nov 2012
    Posts
    24
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Schedule email from list

    Hello Logit,

    Thanks for your response. Unfortunately, your script doesn't accomplish what I'm looking to do.

    I'll elaborate on what I'm trying to get done.

    Below is a sample of the spreadsheet that will be generated on a weekly basis. It contains the names and email addresses of people on a waitlist for a course(s). What I'm trying to do is have a script that would run on a schedule and check the last updated spreadsheet in the folder (Waitlist), search the sheet and locate column O. In column O if there is a value greater than 0 I would like an individual email to be sent to each person's email address (column L) notifying them there's a spot available.

    A B C D E F G H I J K L M N O P
    Year Sess Cat Sec Nbr Descr ID Name Action Requestor Date Email Cap Total Avail Position
    2019
    1
    738 A 60749 History 1000 124919713 Tora Willett Enr
    Tora Willett
    11/19/2018 4:35:09 PM Tora.Willett@hotmail.com 32 32 0 1
    2019
    1 751 1 60811 Business Policy (BPL) 5100 118275089 Codi Gruner Enr
    Codi Gruner
    12/14/2018 11:49:50 AM Codi.Gruner@aol.com 39 38 1 1
    2019
    1 7572 1 60738 Business 9100 189572396 Carmine Paz Enr
    Carmine Paz
    11/19/2018 4:40:24 PM Carmine.Paz@gmail.com 25 24 1 1
    2019
    2 704 1 60755 History 1003 186625577 Audry Fentress Enr
    Audry Fentress
    11/20/2018 4:40:24 PM Audry.Fentress@hotmail.com 11 8 3 1
    2019
    3 705 1 60749 Statistics 1001 228457190 Tu Winborne Enr
    Tu Winborne
    11/21/2018 4:40:24 PM Tu.Winborne@gmail.com 32 31 1 1

    Thanks in advance

  6. #6
    Board Regular Logit's Avatar
    Join Date
    Aug 2016
    Location
    United States
    Posts
    2,640
    Post Thanks / Like
    Mentioned
    34 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Schedule email from list

    .
    I believe this will accomplish the goal. Note the spelling of folders, workbooks and worksheets in the code. Make certain your names match
    those in the code.


    Download workbook : https://www.amazon.com/clouddrive/sh...2RmYQE4bwZerVO

    Code:
    Option Explicit
    
    
    Sub OpenLatestFile()
    
    
        'Declare the variables
        Dim MyPath As String
        Dim MyFile As String
        Dim LatestFile As String
        Dim LatestDate As Date
        Dim LMD As Date
        
        'Specify the path to the folder
        MyPath = Environ("USERPROFILE") & "\Desktop\WaitList\"
        
        'Make sure that the path ends in a backslash
        If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
        
        'Get the first Excel file from the folder
        MyFile = Dir(MyPath & "*.xlsx", vbNormal)
        
        'If no files were found, exit the sub
        If Len(MyFile) = 0 Then
            MsgBox "No files were found...", vbExclamation
            Exit Sub
        End If
        
        'Loop through each Excel file in the folder
        Do While Len(MyFile) > 0
        
            'Assign the date/time of the current file to a variable
            LMD = FileDateTime(MyPath & MyFile)
            
            'If the date/time of the current file is greater than the latest
            'recorded date, assign its filename and date/time to variables
            If LMD > LatestDate Then
                LatestFile = MyFile
                LatestDate = LMD
            End If
            
            'Get the next Excel file from the folder
            MyFile = Dir
       Loop
       
       Dim wb1 As Workbook, wb2 As Workbook, ws1Format As Worksheet, ws2Format As Worksheet
    
    
        Application.ScreenUpdating = False
        Set wb1 = ThisWorkbook
        Set wb2 = Workbooks.Open(MyPath & LatestFile)
        Set ws1Format = wb1.Sheets("Sheet2")
        Set ws2Format = wb2.Sheets("Sheet1")
    
    
        '' Copy the cells of the "Sheet1" worksheet.
        ws2Format.Cells.Copy wb1.Sheets("Sheet2").Range("A1")
    
    
        wb2.Close False 'remove false if you want to be asked if the workbook shall be saved.
        Application.ScreenUpdating = True
       
        eMail
        
        Sheets("Sheet2").UsedRange.ClearContents
        
    End Sub
    
    
    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
    Dim OutApp, OutMail As Object
    Dim FullIdNo As String
    Dim strFilename As String
    
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
    
    Sheet2.Select
    lRow = Cells(Rows.Count, 15).End(xlUp).Row
    For i = 2 To lRow
        If Cells(i, 15).Value > 0 Then
             Set OutApp = CreateObject("Outlook.Application")
             Set OutMail = OutApp.CreateItem(0)
        
                toList = Cells(i, 8)   'gets the recipient email address from col X
                eSubject = "Enrollment available : " & Cells(i, 6).Value 'Refer value from column G (Course Description)
                eBody = "Dear " & Cells(i, 8) & " : " & vbCrLf & vbCrLf & "Just a quick note to advise " & Cells(i, 6) & " Class enrollment is available." & vbCrLf & vbCrLf & _
                "Sincerely, " & vbCrLf & vbCrLf & _
                "Your Signature"
                
                On Error Resume Next
                With OutMail
                .To = toList
                .CC = ""
                .BCC = ""
                .Subject = eSubject
                .Body = eBody
                .Display   ' ********* Creates draft emails. Comment this out when you are ready
                '.Send     '********** UN-comment this when you  are ready to go live
                End With
            
        End If
    Next i
    
    
    On Error GoTo 0
            Set OutMail = Nothing
            Set OutApp = Nothing
    
    
    Application.Goto ActiveWorkbook.Sheets("Sheet1").Range("A1")
    
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    End Sub

  7. #7
    Board Regular Logit's Avatar
    Join Date
    Aug 2016
    Location
    United States
    Posts
    2,640
    Post Thanks / Like
    Mentioned
    34 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Schedule email from list

    .
    theboyscout

    Did the code work for you ?

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
  •