Application.DisplayAlerts Forces Step Into

50 Views Asked by At

When exporting data from an Access query (O365, Version 2310 build 16924) to an Excel template (xltm) the following code "pauses" on the "xl.Application.DisplayAlerts = False" line from time to time and I don't know why.
We have automated the creation of 20 or so excel reports to run every morning from a task manager batch file that kicks off a specific module in Access and sometimes on the 10th or 15th time or even the last time using this code this line is simply yellow like I'm stepping through the code, and there are no error or alert messages, its just stuck in yellow highlight. Most days it works fine with no problems.

Hitting F5 or F8 to step through the code will sometimes work, other times it just can't move forward and I have to restart the entire process.

There are no office or windows updates to do and the computer that runs this has no issues.

Public Function _
ExportToExcelTemplate _
    (QueryName As String, SaveAsFileName As String, Optional SaveAsPath As String = "TempFolder", _
    Optional TemplateFilePath As String = "", Optional ExcelSheetNum As Integer = 1, _
    Optional ExcelCell As String = "A2", Optional CloseFile As Boolean = False, _
    Optional ReportTitle As String = "", Optional PutDateInK1 As Boolean = True)
 
 'On Error Resume Next
 'DoCmd.SetWarnings False
    
    Dim rs As DAO.Recordset
    Dim xl As Excel.Application
    Dim xlwb As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim i As Long
    Dim InsertRange As String
    Dim xlrange As String
    Dim blnWasExcelOpen As Boolean


    If SaveAsPath = "TempFolder" Then
        SaveAsPath = Environ("Temp") & "\"
    End If


'check if SaveAsPath exists, if not exit sub
    If Dir(SaveAsPath, vbDirectory) = vbNullString Then
        GoTo Tidyup
    End If

'if excel is not open, then open it
    On Error Resume Next
    blnWasExcelOpen = True
    Set xl = GetObject(, "Excel.application")
    If xl Is Nothing Then
        blnWasExcelOpen = False
        Set xl = CreateObject("Excel.application")
        On Error GoTo 0
    End If


    xl.Application.DisplayAlerts = False
    xl.Application.ScreenUpdating = False


'Check if FilePath\SaveAsFileName is open or closed
    For i = xl.Workbooks.Count To 1 Step -1  ' if i<>0 then file is open
        If xl.Workbooks(i).Name = SaveAsFileName Then Exit For
    Next

    If TemplateFilePath = "" Then
        Set xlwb = xl.Workbooks.Open(SaveAsPath & SaveAsFileName) 'Open file, this will not error if already open
    Else

'check if template file path exists if so open it and save as
'Exit function if template file path does not exist or Save as file is already open
        
        If Dir(TemplateFilePath) = vbNullString Or i <> 0 Then
            GoTo Tidyup
        Else
            Set xlwb = xl.Workbooks.Open(TemplateFilePath)
            xlwb.SaveAs SaveAsPath & SaveAsFileName, 51 '51 is xlsx, 52 is xlsm
        End If
    End If
  

    Set xlSheet = xlwb.Sheets(ExcelSheetNum)

    Set rs = CurrentDb.OpenRecordset(QueryName)

    rs.MoveLast
    rs.MoveFirst

    If rs.RecordCount > 2 Then
        xlSheet.Activate
        xlSheet.Range(ExcelCell).Offset(1, 0).Activate
        InsertRange = xl.Selection.Address & ":" & xl.Selection.Offset(rs.RecordCount - 3, rs.Fields.Count).Address
        xlSheet.Range(InsertRange).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If


'Move to first cell in spreadsheet and scroll to left
    xl.Application.GoTo Reference:=xlSheet.Range("A1"), Scroll:=True

'Add Date to Report
    If PutDateInK1 Then
        If xlSheet.Range("K1").Value <> "" Then
            xlSheet.Range("K1").Value = Date
        End If
    End If

'Create dummy worksheet for better paste results on date formatting'

    xl.Sheets.Add.Name = "DummyWorkSheet"
    xl.Sheets("DummyWorkSheet").Select
    
    xlSheet.Range(ExcelCell).CopyFromRecordset rs
    If ReportTitle <> "" Then
        xlSheet.Range("A1").Value = ReportTitle
    End If
    
    xl.Sheets("DummyWorkSheet").Delete

'Move to First sheet in workbook
    xl.Sheets(1).Select
    xl.Visible = True
    xlwb.Save
    
Tidyup:
    xl.Application.DisplayAlerts = True
    xl.Application.ScreenUpdating = True
    
    If CloseFile = True Then
        xlwb.Close
        If blnWasExcelOpen = False Then
        xl.Quit
        End If
    End If
    
    
    Set rs = Nothing
    Set xl = Nothing
    Set xlwb = Nothing
    Set xlSheet = Nothing

'DoCmd.SetWarnings True

End Function
1

There are 1 best solutions below

0
CHill60 On

These are the notes I left my colleagues about errors of this type:

So something that has worked for days, months, weeks even years, suddenly produces this error message "Code execution has been interrupted"

You have been no-where near Ctrl-C or Ctrl-Pause/Break for months, and yet here it is. Randomly.

Solution: The solution is to click Debug then hit Ctrl-Pause/Break twice. F5 to run to completion. Save the workbook. Open. Try again. Magic. I kid you not

OR

Another one, something has worked for days, etc etc but now randomly stops on a line of code. No error message, no explanation. Often this will be where you have had a breakpoint in the past, but which is not there now.

Things to try

  1. Close Excel and reopen. Try to run again. Sometimes works
  2. Put a breakpoint on that line (F9) and take it off again. Try to run again. Sometimes works
  3. Debug, Clear All Breakpoints (Ctrl-Shift-F9). Try to run again. Usually works
  4. Make a minor change (e.g. delete a character, type it back in, click onto another line). Debug, Compile VBA Project. Save Workbook and Exit. Try to run again. Always works but is a PITA

OR

  1. Export all of your code modules to text files
  2. Remove all of your code modules
  3. Save and Exit
  4. Import all your code modules
  5. Compile
  6. Save & Exit
  7. Try Again