OUTLOOK 2016 - Add delay to Emails

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
rogerdjrAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

chaauCommented:
What happens if you don't display the UserForm1 within the loop. Also, get rid of DoEvents
rogerdjrAuthor Commented:
Tried your suggestion - What happens if you don't display the UserForm1 within the loop. Also, get rid of DoEvents

See revised code - still only processed 50% of the emails

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
       
'12-09-2015            EmailNo = EmailNo + 1
'12-09-2015            UserForm1.TextBox1 = EmailNo
'12-09-2015            UserForm1.TextBox2 = "Delay = " & Delay
'12-09-2015            UserForm1.Show vbModeless
'12-09-2015            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
'12-09-2015    Unload UserForm1
       
    MsgBox "Start = " & Start & vbNewLine & "End = " & Delay

End Sub
chaauCommented:
I think I know what happens. It is the last command .Send confuses the Loop. What happens in my opinion is the when you send the item from the folder it disappears from the folder and this corrupts the internal index that is used by the For Each loop.

What I can suggest you doing is this: Modify the loop to this:

Do While  ofldr.Items.Count > 0
    mai = ofldr.Items[1]
    With mai
        ' do your stuff
         .Send
    End With
Loop

Open in new window


The last command .Send will send the mail item and reduce the ofldr.Items.Count by one. The loop will work until all items are removed from the folder.

Alternatively use the For...Next loop by counting backwards:

For n As int = ofldr.Items.Count To 1 Step -1
    mai = ofldr.Items[n]
    With mai
        ' do your stuff
         .Send
    End With
Next

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Your Guide to Achieving IT Business Success

The IT Service Excellence Tool Kit has best practices to keep your clients happy and business booming. Inside, you’ll find everything you need to increase client satisfaction and retention, become more competitive, and increase your overall success.

rogerdjrAuthor Commented:
Hmm - tried this modification to the code and get this error message:

Receive Run-time error 91
Object variable or with block variable no set


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
'12-10-2015        For Each mai In ofldr.Items
        Do While ofldr.Items.Count > 0
       
            mai = ofldr.Items(1)

'12-10-2015--------------------------------------------------
            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
    '++++++++++++++++++++++++++++===
       
       
'12-10-2012        Next
            Loop
'12-10-2015--------------------------------------------------
    Unload UserForm1
       
    MsgBox "Start = " & Start & vbNewLine & "End = " & Delay

End Sub
chaauCommented:
My fault. You need to use Set:
Set mai = ofldr.Items[n]

Open in new window

rogerdjrAuthor Commented:
Thanks Problem Solved

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
'12-10-2015        For Each mai In ofldr.Items
        Do While ofldr.Items.Count > 0
       
           Set mai = ofldr.Items(1)

'12-10-2015--------------------------------------------------
            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
    '++++++++++++++++++++++++++++===
       
       
'12-10-2012        Next
            Loop
'12-10-2015--------------------------------------------------
    Unload UserForm1
       
    MsgBox "Start = " & Start & vbNewLine & "End = " & Delay

End Sub
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.