Consulting

Results 1 to 2 of 2

Thread: Automatically send recurring email

  1. #1
    VBAX Regular
    Joined
    Jul 2018
    Posts
    9
    Location

    Automatically send recurring email

    Hi there,

    I would like to send a birthday email automatically. I found a webpage with instructions where an email gets sent when you dismiss the reminder, but the code doesn't work and the author doesn't seem to be responding. Here is the link https://www.extendoffice.com/documen...ing-email.html

    Here the code, I cannot get the email to send. The reminder pop's up, but doesn't send.

    Private Sub Application_Reminder(ByVal Item As Object)
    Dim xMailItem As MailItem
    On Error Resume Next
    If Item.Class <> OlObjectClass.olAppointment Then Exit Sub
    If Item.Categories <> "Send Schedule Recurring Email" Then Exit Sub
    Set xMailItem = Outlook.Application.CreateItem(olMailItem)
    With xMailItem
    .To = Item.Location
    .Subject = Item.Subject
    .Body = Item.Body
    .Send
    End With
    Set xMailItem = Nothing
    End Sub

  2. #2
    VBAX Expert Logit's Avatar
    Joined
    Sep 2016
    Posts
    613
    Location
    .
    This resource is EVERYTHING you will ever want or need to know about sending email via VBA.

    Look it over. Come back when you have questions.

    Here is one example of a scheduled email :

    Option Explicit
    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
    Dim OutMail
    
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
    
    Sheets(1).Select
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    
    For i = 2 To lRow
    toDate = Sheets("Sheet1").Cells(i, 1)
    
    
    If toDate < Date Then: Exit Sub
    
    
      If Left(Cells(i, 3), 4) <> "Mail" And toDate = Date Then '
      
                 Set OutApp = CreateObject("Outlook.Application")
                 Set OutMail = OutApp.CreateItem(0)
            
                    toList = Cells(i, 2)    'gets the recipient from col B
                    eSubject = "Happy Birthday !"   'enter subject title here
                    eBody = "Just taking a moment to wish you a very Happy Birthday !" & vbCrLf & "Hope it's a good day !"
                    
                    'enter email body here
                    
                    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, 3) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column C"
                 
        End If
    Next i
    ActiveWorkbook.Save
    
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    MsgBox "All emails have been sent. ", vbInformation, "Email Notice "
    
    
    End Sub
    Attached Files Attached Files

Posting Permissions

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