Cannot Quit at this time Error

Good afternoon,

I hoping someone can help me because i'm completely baffled. Every morning at 8am have an excel file that opens up via a task scheduler command, after 56 minutes @ 8:56 excel trys to close of its own accord and I get this message from excel saying "Cannot Quit at this time" from a "Microsoft Visual Basic for Applications" pop up box, This stops everything from running and i have to clear the message before it will continue, once i clear the message it will run fine for the rest of the day until tomorrow at 8:56am. I can guarantee there is nothing in my vba code that attempts to close down my excel at this time. I will add all of my vba below.

If anyone could help i would be really grateful.

Module 1

Sub Close_Workbook()
Application.DisplayAlerts = False
Application.Quit
End Sub

Module 2

Sub Refresh()
Application.OnTime Now + TimeValue("00:00:30"), "Refresh"
If Worksheets("Data").Range("T2").Value = "" Then Exit Sub
ActiveWorkbook.Connections("Query from csolve5").Refresh
ActiveWorkbook.Connections("Query from csolve3").Refresh
ActiveWorkbook.Connections("Connection").Refresh
''Application.Run "'Card Report v5.xlsm'!Refresh"
   
Sheets("Data").Select
Range("Table_Query_from_csolve[[#Headers],[DebtorID]]").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("All Cards").Select
   ' Select the range of cells on the active worksheet.
   With Sheets("All Cards").Range("A1:I50")
   ActiveSheet.Range("A1:I50").Select
   End With
   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True
   
   ' Set the optional introduction field thats adds
   ' some header text to the email body. It also sets
   ' the To and Subject lines. Finally the message
   ' is sent.
   With ActiveSheet.MailEnvelope
      '.Introduction = ""
      .Item.To = "[email protected]"
      '.Item.CC = "[email protected]"
      .Item.Subject = [Z1] & " " & Format(Date, "dd/mm/yy")
      .Item.Send
      Application.OnTime Now + TimeValue("00:00:30"), "Refresh"
      End With
      Application.OnTime Now + TimeValue("00:00:30"), "Refresh"
End Sub

This Workbook

Private Sub Workbook_Open()


  Application.OnTime Now + TimeValue("00:00:30"), "Refresh"
  Application.OnTime TimeValue("20:15:00"), "Close_Workbook"
  
  'Cancel any previous scheduled run
    On Error Resume Next
    Application.OnTime TimeValue("20:05:00"), "Refresh", , False
    Application.OnTime TimeValue("20:15:00"), "Close_Workbook", , False
    On Error GoTo 0

'Add scheduled run again
Application.OnTime TimeValue("20:15:00"), "Close_Workbook"
    
     Set objmessage = CreateObject("CDO.Message")
      Set objconfig = CreateObject("CDO.Configuration")
       
      Recipients = "[email protected]"                                                               'Type in your own recipient'
      ''CC = ""                                                                                                      'Self Explanatory'
      ''BCC = ""                                                                                                     'Self Explanatory'
      From = "[email protected]"                                                                                          'No Spaces'
      Subject = "Card Report is Active - " & Format(Now(), "hh:mm")                                            'This can whatever the message needs to be
      HTMLBody = "*****File Opended Successfully*****"                                                                                    'This can whatever the message needs to be'"
      With objconfig.Fields
                  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2                              'Do not change'
                  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SMTP.local.1stcreditltd.com" 'This needs to the name of your compnay exchange'
                  .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30                 'Do not change'
                  .Update
      End With
      With objmessage
                  .Configuration = objconfig
                  .To = Recipients
                  .CC = CC
                  .BCC = BCC
                  .From = From
                  .Subject = Subject
                  .HTMLBody = HTMLBody
                  .Send
      End With
      'Destroy Objects
      'Set objmessage = Nothing
      'Set objconfig = Nothing
  
' VBMail Ends Here

    End Sub

No other VBA is present in the sheet




Thanks in advance DJ

Hi,

Why does your Refresh routine reschedule itself 3 times? It would seem to me that that will create an enormous schedule of refreshes quite quickly, and that probably conflicts with your scheduled Close routine, which may be trying to close while a connection is refreshing.

Private Sub Workbook_Open()


  Application.OnTime Now + TimeValue("00:00:30"), "Refresh"
  Application.OnTime TimeValue("20:15:00"), "Close_Workbook"
  
  'Cancel any previous scheduled run
    On Error Resume Next
    Application.OnTime TimeValue("20:05:00"), "Refresh", , False
    Application.OnTime TimeValue("20:15:00"), "Close_Workbook", , False
    On Error GoTo 0

'Add scheduled run again
Application.OnTime TimeValue("20:15:00"), "Close_Workbook"

This is confusing. Why schedule OnTime events; cancel them; then reschedule them?

Also, this....
Application.OnTime TimeValue("20:05:00"), "Refresh", , False
Does not cancel this...
Application.OnTime Now + TimeValue("00:00:30"), "Refresh"
...because the Now command makes the time values different between the two, and the On Error Resume Next hides the error.

You could store the Now + TimeValue("00:00:30") value as a public variable then use that variable to cancel the event when necessary.