VBA Loop on error

[stormsabove]

Hello All,

I have a VBA script that takes a spreadsheet, saves it, then sends it as an attatchment in an email. However, sometimes the internet drops temporarily, so I'd like it to attempt to resend a few times before failing. I've come up with this:

Sub email()    Dim Msg As Object
    Dim Conf As Object
    Dim msgBody As String
    Dim ConfFields As Variant
    Dim wb As Workbook
    Dim FilePath As String
    Dim FileName As String
    Dim ErrorCount As Long
    
    Excel.Application.Visible = True
    ErrorCount = 0
    Range("A1").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        
    End With
    
    Set wb = ActiveWorkbook
    
    FilePath = "C:\Users\ME\Documents\Reports\"
    
    FileName = "Report " & Format(Now() - 1, "MM_DD_YY") & ".xlsx"


    ActiveWorkbook.SaveAs Path & FileName, xlOpenXMLWorkbook


    wb.SaveCopyAs FilePath & FileName
    
SendEmail:


    If ErrorCount < 5 Then
    
    Set Msg = CreateObject("CDO.Message")
    Set Conf = CreateObject("CDO.Configuration")


    Conf.Load -1    ' CDO Source Defaults
    Set ConfFields = Conf.Fields
    With ConfFields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        'Enter the username and password of your email account below
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "EMAILADDRESS"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "PASSWORD"
        'Edit the SMTP server below e.g. smtp.gmail.com or smtp.mail.yahoo.co.uk
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Update
    End With




    msgBody = "Hello," & vbNewLine & vbNewLine & _
              "Your Report is complete."


    With Msg
        On Error GoTo RetrySending
        Set .Configuration = Conf
        'Add the email address to whom to send the email below
        .To = "user@useremail.com"
        .CC = ""
        .BCC = ""
        .From = """Your_Email"" <YourEmail@Emai.com>"
        .Subject = "Your Daily Report for " & Format(Now() - 1, "MM_DD_YY")
        .TextBody = msgBody
        .AddAttachment FilePath & FileName
        .Send
        On Error GoTo RetrySending
    End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    
    ActiveWorkbook.Close
    Workbooks(FilePath + FileName).Close
    
    End If
   
RetrySending:
        ErrorCount = ErrorCount + 1
        'Allow the application to wait for 5 minutes
        Application.Wait (Now + TimeValue("0:02:00"))
        'Try the query again
        GoTo SendEmail
                
    On Error GoTo RetrySending
    
   
    
    If ErrorCount > 5 Then
        MsgBox "Too many retries"
    Exit Sub
    
    End If


    
End Sub

It seems to work great when internet is stable. If the internet drops, it retrys once before it pops up an error that there was a connection timeout. Any suggestions / improvements to make this script behave better?

Thanks!

 

[JonXL]

What if you replace this...

RetrySending:
        ErrorCount = ErrorCount + 1
        'Allow the application to wait for 5 minutes
        Application.Wait (Now + TimeValue("0:02:00"))
        'Try the query again
        GoTo SendEmail
                
    On Error GoTo RetrySending

... with this? (not tested at all, but just similar to code I use to accomplish a similar task of waiting for another program to be ready)

On Error Resume Next
Err.Clear
x = 0

Do
    Err.Clear
    Application.Wait (Now + TimeValue("0:00:05"))
    'Try the query
    x = x + 1
Loop Until Err.Number = 0 or x >= 60

Err.Clear
On Error Goto 0

The idea here is that instead of waiting a solid two minutes no matter what, the code waits up to 5 minutes but tries every 5 seconds...

 

[stormsabove]

I'll give it a go and let you know how it works!