Works first time not second time

[David]

I have a button uses the below code to create a report by
- creating a query
- copying the query via DAO recordset to Excel
The Excel end is a workbook per month and a worksheet per day named
accordingly.

To set up a new workbook per month I have the code try to open the current
month and if it doesn't exist it goes through the error handling to creating
a new file.

This code works well and the first file is created but when it comes to go
through for the second time the error doesn't appear to be handled through my
code and it goes directly to a debugging screen in the VB window.

Why does it do that?

Thanks
David


Private Sub Command0_Click()

On Error GoTo Err_ExcelForm

'recordset dims
Dim db As DAO.Database
Dim rs As DAO.Recordset

'excel automation dims
Dim xlBookName As String
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

'date usage dims
Dim runningDate As Date
Dim LastReportDate As Date

'query creation dims
'query used to create recordset
Dim CurrentFormQuery As QueryDef
Dim QuerySQL As String
Dim QueryName As String

'find date the report was printed last. If today then exit
LastReportDate = DLookup("ReportDate", "MessageLine")
If LastReportDate = Date Then
MsgBox "No History to Report"
Exit Sub
End If

'start loop for each day's report
For runningDate = LastReportDate To Date - 1

QuerySQL = "SELECT FullDetails.* FROM FullDetails WHERE
FlightDate=#" & runningDate & "#;"
QueryName = "DailyFullDetails"
Set CurrentFormQuery = CurrentDb.CreateQueryDef(QueryName, QuerySQL)
xlBookName = "N:\Rpt\" & Year(runningDate) & "-" &
MonthName(Month(runningDate)) & ".xls"



'(((((((((((((((( Start of excel file setup
ExcelSetup:
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(xlBookName)
xlBook.Sheets.Add
xlApp.ActiveSheet.Name = Day(runningDate) & "-" &
WeekdayName(Weekday(runningDate), True)
Set xlSheet = xlApp.ActiveSheet
GoTo insertData
CreateFile:
Set xlBook = xlApp.Workbooks.Add
With xlApp
.Sheets(3).Select
.ActiveWindow.SelectedSheets.Delete
.Sheets(2).Select
.ActiveWindow.SelectedSheets.Delete
.Sheets(1).Select
.ActiveSheet.Name = Day(runningDate) & "-" &
WeekdayName(Weekday(runningDate), True)
End With
Set xlSheet = xlApp.ActiveSheet
GoTo insertData

')))))))))))))))) End of excel file setup

'(((((((((((((((( Start of insert to excel activesheet

insertData:
'get recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("DailyFullDetails", dbOpenSnapshot)
'setup for
Dim i As Integer
Dim iNumFields As Integer
iNumFields = rs.Fields.Count
'insert fieldnames
For i = 1 To iNumFields
xlSheet.Cells(1, i).Value = rs.Fields(i - 1).Name
Next
'insert data
xlSheet.Range("A2").CopyFromRecordset rs

'resize column width
With xlSheet.Range("a1").Resize(1, iNumFields)
.Font.Bold = True
.EntireColumn.AutoFit
End With
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
xlApp.ActiveWindow.Visible = True
xlApp.ActiveWorkbook.SaveAs Filename:=xlBookName
xlApp.ActiveWorkbook.Save
xlBook.Close
xlApp.Quit

Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
DoCmd.DeleteObject acQuery, "DailyFullDetails"

')))))))))))))))) End of insert to excel activesheet

'MsgBox "made book " & runningDate
'next loop for each day's report
Next runningDate

Exit_ExcelForm:
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
Err_ExcelForm:
If Err.Number = 1004 And Mid(Err.Description, 2, 3) = "N:\" Then GoTo
CreateFile
MsgBox "CaughtInMyCode " & Err.Number & Err.Description
Resume Exit_ExcelForm

End Sub

 

[DomThePom]

You need to step through your code and determine why errors are occurring -
look at the value of variables after each step.

2 pointers for you:

- you dont need a query deff object to open a recordset - just use your sql
statement
- your code is full of goto's! These should be avoided at all cats in VBA -
if you want to do something then do it in another sub.

 

[David]

Thanks for that.
I have removed the step of creating the query. That was an unecesary step.

I have tried stepping through the code line by line. It works really well
and it the excel application closes completely each time its just that the
second time the code runs through the loop the error doesn't run through my
error handling it comes up in a normal VBA error window as if my On Error
statement doesn't exist

Any ideas?
David

 

[David]

I got it!
I changed:
If Err.Number = 1004 And Mid(Err.Description, 2, 3) = "N:\" Then GoTo
CreateFile
to:
If Err.Number = 1004 And Mid(Err.Description, 2, 3) = "N:\" Then Resume
CreateFile

it seems it wasn't clearing the error information.
Just in case anyone has the same prob

David