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
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
OR