troubleshooting Question

OUTLOOK 2016 - Add delay to Emails

Avatar of rogerdjr
rogerdjrFlag for United States of America asked on
OutlookVisual Basic ClassicMicrosoft OfficeVBA
6 Comments2 Solutions542 ViewsLast Modified:
After doing a word merge to send a large number of emails I run this macro to add delay to each one so I don't exceed the allowed number of emails per hour.

It works fine except  that it only processes 50% of the emails in the folder selected (Set ofldr = Session.PickFolder)

I am puzzeled can anybody help?

Sub AddDelayToEmails()
   
    Dim mai As MailItem 'Object
    Dim acct As Long
    Dim Delay As Date, Start As Date
    Dim UpdtCount As Integer
    Dim FirstNm As String
    Dim AddAttachment As Integer
    Dim EmailsPerHour As Integer
    Dim FolderCheck As Integer, FolderName As String
    Dim EmailNo As Integer
    Dim ofldr As Object
   
   
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.propertyAccessor
    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
   
    EmailNo = 1
   
    MsgBox "Select Email Folder"
    Set ofldr = Session.PickFolder

    AddAttachment = MsgBox("Do You Want to Add an Attachment" & vbNewLine & vbNewLine & "z:\EPM Proposals\Roger D  Miller Jr .vcf", vbYesNo + vbDefaultButton2)
    EmailsPerHour = InputBox("How Many Emails Per Hour do you want to send?", , 30)
   
    Delay = Now() + 3 / 24 ' + 1 ' / 24
    Start = Delay
    MsgBox Start
    UpdtCount = 0
        For Each mai In ofldr.Items
       
            If mai.Class = olMail Then
                With mai
                   
'                    .CC = "mochs@quaillodge.com; salexander@axisonline.net; mjohnston@axisonline.net; steven@hoodandassociates.net; MatthewOMALEY@peninsula.com"
                    .Importance = olImportanceHigh
'                    .ReadReceiptRequested = True
'                    .OriginatorDeliveryReportRequested = True
'                    .Attachments.Add "J:\11 Jobs\11813 First Capital Bank CM - Arch Selection 300 Bonafacio\Project Manager\Hazardous Materials Survey RFP\11813 First Capital Bank CM - Arch Selection 300 Bonafacio Hazardous Material Survey RFP Drawings 09-19-2011.pdf", olEmbeddeditem
'                    .Subject = .Subject & String(UpdtCount, " ")
                    .DeferredDeliveryTime = Delay
                    .OriginatorDeliveryReportRequested = True
'12-09-2014                    .FlagRequest = "Follow-up"
'12-09-2014                    .ReminderTime = Now + 14
'12-09-2014                    .ReminderSet = True
'12-09-2014                   .Subject = FirstNm & " Could you benefit from Facility Condition Assessment Consulting Services"
            UpdtCount = UpdtCount + 1
            If UpdtCount = EmailsPerHour Then
                Delay = DateAdd("n", 60, Delay) ' adds 60 minutes
                UpdtCount = 0
            End If
       
            EmailNo = EmailNo + 1
            UserForm1.TextBox1 = EmailNo
            UserForm1.TextBox2 = "Delay = " & Delay
            UserForm1.Show vbModeless
            DoEvents
                   
                   
                    .Send
'                    .Save
                End With
            End If
           
    '++++++++++++++++++++++++++++===
    ''+++Sue Mosher   14-May-2003  17:45
    ''+++DeferredDeliveryTime takes a date/time value. (You can look these things up in Help -- in VBA,
    ''+++press F2 to get the object browser, select the property, then press F1.)
    ''+++You can use the DateAdd() function to add 15 minutes to the current date/time:
    ''+++dteThen = dateadd("n", 15, Now)
    ''+++objMail.DeferredDeliveryTime = dteThen
    '++++++++++++++++++++++++++++===
        Next
    Unload UserForm1
       
    MsgBox "Start = " & Start & vbNewLine & "End = " & Delay

End Sub
ASKER CERTIFIED SOLUTION
Log in to continue reading
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform for $9.99/mo
View membership options
Unlock 2 Answers and 6 Comments.
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
The Value of Experts Exchange in My Daily IT Life

Experts Exchange (EE) has become my company's go-to resource to get answers. I've used EE to make decisions, solve problems and even save customers. OutagesIO has been a challenging project and... Keep reading >>

Mike

Owner of Outages.IO
Phoenix, Arizona, United States
Member Since 2016
Join a full scale community that combines the best parts of other tools into one platform.
Unlock 2 Answers and 6 Comments.
View membership options
“All of life is about relationships, and EE has made a virtual community a real community. It lifts everyone's boat.”
William Peck

Member since 2004