VBA to send multiple emails, run time error 440 after ~30 emails

P

PLLL

New Member
Joined
Mar 1, 2023
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Hi All, I have some code which does a great job (mostly) of sending out monthly statements of which I have ~300. However I get runtime error 440 after it generates about 30 emails (different number each time) and I therefore have to send them out in batches. When I click debug it is always the ".To" line which is the problem, but there is no issue with the email addresses listed and as the number of emails it generates before the error varies I cant attribute the issue to any particular line or email address. Here is my code, is anyone able to assist please?

It is probably worth noting that for most of the emails the statements are just copied and pasted into the email body but where column M is equal to "1234" then an excel email attachment of the budget is also sent. There isnt a problem with this element of the code but I just mention it incase you wonder what's going on.

VBA Code: 
Sub runmacro()


Dim response As VbMsgBoxResult

'You need to unlock the statements in cell D1
   If Sheets("01. STATEMENT").Range("D1").Value <> "SEND EMAILS UNLOCKED" Then
    response = MsgBox("Cell D1 must be set to 'SEND EMAILS UNLOCKED' to continue", vbOKOnly)
    If response = vbOK Then Exit Sub
   
    End If
'2 message boxes to give you a chance to cancel before sending out the emails
    response = MsgBox("You are about to send ~400 email statements, do you want to continue??", vbOKCancel + vbInformation)
    If response = vbCancel Then Exit Sub

    response = MsgBox("ARE YOU SURE??", vbOKCancel + vbInformation)
    If response = vbCancel Then Exit Sub
   
'Filter only on the budget categories with either expenditure or budget or both
ActiveSheet.ShowAllData
ActiveSheet.Range("$G$1:$R$5001").AutoFilter Field:=1, Criteria1:="YES"

'Set statements back to locked so they are locked next time you open the spreadsheet
Range("D1").Value = "SEND EMAILS LOCKED"

'Loop through the macro for all the seperate statements:

Dim n As Long
For n = 7 To 4997 Step 10
   Mail_Selection_Range_Outlook_Body CStr(n)
Next n

End Sub

Sub Mail_Selection_Range_Outlook_Body(ByVal row As String)

'If the statement is active then continue or skip
 If Sheets("01. STATEMENT").Range("H" & row).Value = "YES" Then
   
    Dim OutApp1 As Object
    Dim OutMail1 As Object
    Dim wdDoc1 As Object
    Dim oRng1 As Object
      
    Set OutApp1 = CreateObject("Outlook.Application")
    Set OutMail1 = OutApp1.CreateItem(0)
   
 If Sheets("01. STATEMENT").Range("m" & row).Value = "1234" Then
'Set the name and file location of the excel attachment
Excelfile = ActiveWorkbook.FullName
  i = InStrRev(Excelfile, ".")
  If i > 1 Then Excelfile = Left(Excelfile, i - 1)
Excelfile = Environ("USERPROFILE") & "\OneDrive - x\Documents\" & Sheet1.Range("J" & row) & " Financial Report " & Format(Sheet1.Range("C1"), "mmm.yy") & ".xlsx"

'Create the excel attachment
    Range("A" & row - 5 & ":" & "E" & row + 4).Select
    Selection.Copy
    Workbooks.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.SaveAs Filename:=Excelfile
    ActiveWorkbook.Close
   
End If

'Copy the statement to post into the email body
    Workbooks("x statements LIVE.xlsm").Activate
   Sheets("01. STATEMENT").Range("A" & row - 5 & ":" & "E" & row + 4).Select
    Selection.Copy
   
'Create the email
    With OutMail1
        .Display
        .To = Sheets("01. STATEMENT").Range("O" & row)
        .Cc = Sheets("01. STATEMENT").Range("R" & row)
        .Subject = Sheets("01. STATEMENT").Range("J" & row) & " " & Sheets("01. STATEMENT").Range("K" & row) & "Financial Report " & Sheets("01. STATEMENT").Range("C1")
        .Body = ""
       
 If Sheets("01. STATEMENT").Range("m" & row).Value = "1234" Then
         .Attachments.Add Excelfile
           
'Delete the excel file from one drive
            Kill (Excelfile)

End If
           
    'Email body AFTER statement
         .htmlbody = "This email account is not monitored"
                Set olInsp = .GetInspector
            Set wdDoc1 = olInsp.WordEditor
            Set oRng1 = wdDoc1.Range
            oRng1.collapse 1
            oRng1.Paste
            For Each shp In wdDoc1.InlineShapes
            shp.ScaleHeight = 110
            shp.ScaleWidth = 110
            Next
'Email body BEFORE statement
         .htmlbody = "<font style='font-family:calibri;font-size:15.0'>" & "Dear " & Sheet1.Range("N" & row) & "," & "<br>" & "<br>" _
    & Sheets("01. STATEMENT").Range("K" & row) & " / Please find the financial report for the " & Sheets("01. STATEMENT").Range("K" & row) & " project below." & "<br>" & "<br>" & .htmlbody


    End With
    On Error GoTo 0

    Set OutMail1 = Nothing
    Set OutApp1 = Nothing

End If

End Sub
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
First, instead of creating a new instance of Outlook each time you create an new email, create it once and then refer to that same instance each time it's needed. Then try adding DoEvents (and possibly pause the macro for a few seconds) after each email is created. I have amended your code accordingly. Note that I have added the function PauseMacro to your code.

Does this help?

VBA Code: 
Option Explicit

Dim OutApp1 As Object

Sub runmacro()


Dim response As VbMsgBoxResult

'You need to unlock the statements in cell D1
   If Sheets("01. STATEMENT").Range("D1").Value <> "SEND EMAILS UNLOCKED" Then
    response = MsgBox("Cell D1 must be set to 'SEND EMAILS UNLOCKED' to continue", vbOKOnly)
    If response = vbOK Then Exit Sub
  
    End If
'2 message boxes to give you a chance to cancel before sending out the emails
    response = MsgBox("You are about to send ~400 email statements, do you want to continue??", vbOKCancel + vbInformation)
    If response = vbCancel Then Exit Sub

    response = MsgBox("ARE YOU SURE??", vbOKCancel + vbInformation)
    If response = vbCancel Then Exit Sub
  
'Filter only on the budget categories with either expenditure or budget or both
ActiveSheet.ShowAllData
ActiveSheet.Range("$G$1:$R$5001").AutoFilter Field:=1, Criteria1:="YES"

'Set statements back to locked so they are locked next time you open the spreadsheet
Range("D1").Value = "SEND EMAILS LOCKED"

Set OutApp1 = CreateObject("Outlook.Application")

'Loop through the macro for all the seperate statements:
Dim n As Long
For n = 7 To 4997 Step 10
   Mail_Selection_Range_Outlook_Body CStr(n)
   PauseMacro 3 'three second pause (change as desired)
Next n

Set OutApp1 = Nothing

End Sub

Sub Mail_Selection_Range_Outlook_Body(ByVal row As String)

'If the statement is active then continue or skip
 If Sheets("01. STATEMENT").Range("H" & row).Value = "YES" Then
  
    Dim OutMail1 As Object
    Dim wdDoc1 As Object
    Dim oRng1 As Object
      
    Set OutMail1 = OutApp1.CreateItem(0)
  
 If Sheets("01. STATEMENT").Range("m" & row).Value = "1234" Then
'Set the name and file location of the excel attachment
Excelfile = ActiveWorkbook.FullName
  i = InStrRev(Excelfile, ".")
  If i > 1 Then Excelfile = Left(Excelfile, i - 1)
Excelfile = Environ("USERPROFILE") & "\OneDrive - x\Documents\" & Sheet1.Range("J" & row) & " Financial Report " & Format(Sheet1.Range("C1"), "mmm.yy") & ".xlsx"

'Create the excel attachment
    Range("A" & row - 5 & ":" & "E" & row + 4).Select
    Selection.Copy
    Workbooks.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.SaveAs Filename:=Excelfile
    ActiveWorkbook.Close
  
End If

'Copy the statement to post into the email body
    Workbooks("x statements LIVE.xlsm").Activate
   Sheets("01. STATEMENT").Range("A" & row - 5 & ":" & "E" & row + 4).Select
    Selection.Copy
  
'Create the email
    With OutMail1
        .Display
        .To = Sheets("01. STATEMENT").Range("O" & row)
        .Cc = Sheets("01. STATEMENT").Range("R" & row)
        .Subject = Sheets("01. STATEMENT").Range("J" & row) & " " & Sheets("01. STATEMENT").Range("K" & row) & "Financial Report " & Sheets("01. STATEMENT").Range("C1")
        .Body = ""
      
 If Sheets("01. STATEMENT").Range("m" & row).Value = "1234" Then
         .Attachments.Add Excelfile
          
'Delete the excel file from one drive
            Kill (Excelfile)

End If
          
    'Email body AFTER statement
         .htmlbody = "This email account is not monitored"
                Set olInsp = .GetInspector
            Set wdDoc1 = olInsp.WordEditor
            Set oRng1 = wdDoc1.Range
            oRng1.collapse 1
            oRng1.Paste
            For Each shp In wdDoc1.InlineShapes
            shp.ScaleHeight = 110
            shp.ScaleWidth = 110
            Next
'Email body BEFORE statement
         .htmlbody = "<font style='font-family:calibri;font-size:15.0'>" & "Dear " & Sheet1.Range("N" & row) & "," & "<br>" & "<br>" _
    & Sheets("01. STATEMENT").Range("K" & row) & " / Please find the financial report for the " & Sheets("01. STATEMENT").Range("K" & row) & " project below." & "<br>" & "<br>" & .htmlbody


    End With
    On Error GoTo 0

    Set OutMail1 = Nothing

End If

End Sub

Sub PauseMacro(ByVal secs As Long)

    Dim endTime As Single
    endTime = Timer + secs
    
    Do
        DoEvents
    Loop Until Timer > endTime
    
End Sub
 
Upvote 0
Domenic said:
First, instead of creating a new instance of Outlook each time you create an new email, create it once and then refer to that same instance each time it's needed. Then try adding DoEvents (and possibly pause the macro for a few seconds) after each email is created. I have amended your code accordingly. Note that I have added the function PauseMacro to your code.

Does this help?

VBA Code: 
Option Explicit

Dim OutApp1 As Object

Sub runmacro()


Dim response As VbMsgBoxResult

'You need to unlock the statements in cell D1
   If Sheets("01. STATEMENT").Range("D1").Value <> "SEND EMAILS UNLOCKED" Then
    response = MsgBox("Cell D1 must be set to 'SEND EMAILS UNLOCKED' to continue", vbOKOnly)
    If response = vbOK Then Exit Sub
 
    End If
'2 message boxes to give you a chance to cancel before sending out the emails
    response = MsgBox("You are about to send ~400 email statements, do you want to continue??", vbOKCancel + vbInformation)
    If response = vbCancel Then Exit Sub

    response = MsgBox("ARE YOU SURE??", vbOKCancel + vbInformation)
    If response = vbCancel Then Exit Sub
 
'Filter only on the budget categories with either expenditure or budget or both
ActiveSheet.ShowAllData
ActiveSheet.Range("$G$1:$R$5001").AutoFilter Field:=1, Criteria1:="YES"

'Set statements back to locked so they are locked next time you open the spreadsheet
Range("D1").Value = "SEND EMAILS LOCKED"

Set OutApp1 = CreateObject("Outlook.Application")

'Loop through the macro for all the seperate statements:
Dim n As Long
For n = 7 To 4997 Step 10
   Mail_Selection_Range_Outlook_Body CStr(n)
   PauseMacro 3 'three second pause (change as desired)
Next n

Set OutApp1 = Nothing

End Sub

Sub Mail_Selection_Range_Outlook_Body(ByVal row As String)

'If the statement is active then continue or skip
 If Sheets("01. STATEMENT").Range("H" & row).Value = "YES" Then
 
    Dim OutMail1 As Object
    Dim wdDoc1 As Object
    Dim oRng1 As Object
     
    Set OutMail1 = OutApp1.CreateItem(0)
 
 If Sheets("01. STATEMENT").Range("m" & row).Value = "1234" Then
'Set the name and file location of the excel attachment
Excelfile = ActiveWorkbook.FullName
  i = InStrRev(Excelfile, ".")
  If i > 1 Then Excelfile = Left(Excelfile, i - 1)
Excelfile = Environ("USERPROFILE") & "\OneDrive - x\Documents\" & Sheet1.Range("J" & row) & " Financial Report " & Format(Sheet1.Range("C1"), "mmm.yy") & ".xlsx"

'Create the excel attachment
    Range("A" & row - 5 & ":" & "E" & row + 4).Select
    Selection.Copy
    Workbooks.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.SaveAs Filename:=Excelfile
    ActiveWorkbook.Close
 
End If

'Copy the statement to post into the email body
    Workbooks("x statements LIVE.xlsm").Activate
   Sheets("01. STATEMENT").Range("A" & row - 5 & ":" & "E" & row + 4).Select
    Selection.Copy
 
'Create the email
    With OutMail1
        .Display
        .To = Sheets("01. STATEMENT").Range("O" & row)
        .Cc = Sheets("01. STATEMENT").Range("R" & row)
        .Subject = Sheets("01. STATEMENT").Range("J" & row) & " " & Sheets("01. STATEMENT").Range("K" & row) & "Financial Report " & Sheets("01. STATEMENT").Range("C1")
        .Body = ""
     
 If Sheets("01. STATEMENT").Range("m" & row).Value = "1234" Then
         .Attachments.Add Excelfile
         
'Delete the excel file from one drive
            Kill (Excelfile)

End If
         
    'Email body AFTER statement
         .htmlbody = "This email account is not monitored"
                Set olInsp = .GetInspector
            Set wdDoc1 = olInsp.WordEditor
            Set oRng1 = wdDoc1.Range
            oRng1.collapse 1
            oRng1.Paste
            For Each shp In wdDoc1.InlineShapes
            shp.ScaleHeight = 110
            shp.ScaleWidth = 110
            Next
'Email body BEFORE statement
         .htmlbody = "<font style='font-family:calibri;font-size:15.0'>" & "Dear " & Sheet1.Range("N" & row) & "," & "<br>" & "<br>" _
    & Sheets("01. STATEMENT").Range("K" & row) & " / Please find the financial report for the " & Sheets("01. STATEMENT").Range("K" & row) & " project below." & "<br>" & "<br>" & .htmlbody


    End With
    On Error GoTo 0

    Set OutMail1 = Nothing

End If

End Sub

Sub PauseMacro(ByVal secs As Long)

    Dim endTime As Single
    endTime = Timer + secs
   
    Do
        DoEvents
    Loop Until Timer > endTime
   
End Sub
Click to expand...
This is brilliant! it works perfectly! thankyou! When it creates 100 emails it stops as outlook tells me to close some windows but thats fine, now that it all works I can change the code so it sends the emails straighaway rather than just displaying them all.

There is just one more thing I would like to add in if you could help please? (it will take me hours to work it out) the number of statements varies month by month but there is capacity for 400, is there a way of stopping the macro when it reaches a row with #N/A in it (the bottom of the data) and then a message box popping up which says "All statements sent"?
 
Upvote 0
PLLL said:
This is brilliant! it works perfectly! thankyou!
Click to expand...
You're very welcome, I'm glad I could help.

PLLL said:
When it creates 100 emails it stops as outlook tells me to close some windows but thats fine
Click to expand...
I'm not sure what's happening there, but I would suggest that you start a new thread, provide some details, and ask for someone to help. Maybe it can be dealt with by code.

PLLL said:
There is just one more thing I would like to add in if you could help please? (it will take me hours to work it out) the number of statements varies month by month but there is capacity for 400, is there a way of stopping the macro when it reaches a row with #N/A in it (the bottom of the data) and then a message box popping up which says "All statements sent"?
Click to expand...
Which column are we checking? Let's say that it's Column H, try...

VBA Code: 
'Loop through the macro for all the seperate statements:
Dim n As Long
For n = 7 To 4997 Step 10
    If IsError(Sheets("01. STATEMENT").Range("H" & n).Value) Then 'change the column accordingly
        MsgBox "All statements sent.", vbInformation
        Exit For
    End If
    Mail_Selection_Range_Outlook_Body CStr(n)
    PauseMacro 3 'three second pause
Next n

Hope this helps!
 
Upvote 0
Domenic said:
You're very welcome, I'm glad I could help.


I'm not sure what's happening there, but I would suggest that you start a new thread, provide some details, and ask for someone to help. Maybe it can be dealt with by code.


Which column are we checking? Let's say that it's Column H, try...

VBA Code: 
'Loop through the macro for all the seperate statements:
Dim n As Long
For n = 7 To 4997 Step 10
    If IsError(Sheets("01. STATEMENT").Range("H" & n).Value) Then 'change the column accordingly
        MsgBox "All statements sent.", vbInformation
        Exit For
    End If
    Mail_Selection_Range_Outlook_Body CStr(n)
    PauseMacro 3 'three second pause
Next n

Hope this helps!
Click to expand...
Perfect! that works a treat. Thank you so much for all of your help :)
 
Upvote 0
That's great to hear, glad I could help, cheers!
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA sending an email of two conditions are met
Replies
5
Views
136
mumps
mumps
L
  • Question Question
Sending Email with Table in Body
Replies
3
Views
610
Domenic
D
crook_101
  • Question Question
VBA to loop when sending email
Replies
1
Views
221
crook_101
crook_101
S
  • Solved
Tweak to VBA email code
Replies
3
Views
757
rollis13
rollis13
B
  • Solved
VBA to email recipient if column cells contain value
Replies
6
Views
540
bh24524
B

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top