Access 2000 report to Excel

[Gaupo]

I have created an access DB which builds a report in Excel the item works as it should until I try and run it a second time. On the second attempt it will bring up access and put in all fields but none of the formatting will take place. If I restart the DB it will work correctly the first time. How do I fix this. Also on the second run I get the error:

91: Object variable or with block variable not set

 

[RoyVidar]

Probably implicit referencing of excel objects and properties. Have a look at this Excel automation fails second time code runs

Roy-Vidar

 

[Gaupo]

I did try using the suggestions from the URL above, but it was the same result. The code I am using brings excel up and pulls the data fine but the formatting part does not work on the second try. Here is a copy of the code that will not work on 2nd try.

Sub PageSet()

With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Range("B:B,C:C,E:E").Select
Range("E1").Activate
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("J:J").Select
Selection.NumberFormat = "m/d/yyyy"
Range("A1").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "SUSPENSE TRACKING SYSTEM " & Chr(10) & "OPEN TASKINGS"
.RightHeader = "As of &D"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 355
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Sub


Any help you can give will be very much appreciated.

 

[RoyVidar]

I can't find anything implemented from the Microsoft KB Article.

Every Excel object must be qualified through an Excel object variable.

Since you haven't posted how you declare and instantiate Excel, see this thread thread705-1062378 for more info (see how PHV have highlighted changes).

Roy-Vidar

 

[Gaupo]

This is how I call the first mod.

Option Compare Database
Option Explicit
Private Const conQuery = "Q_Track_Open_E"
Private Const conSheetName = "Open Tasks"

Public Sub ExcelWorkBook()

Dim rst As ADODB.Recordset
'Call GetFormatInfo
' Excel object variables
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
'Dim xlChart As Excel.Chart
Dim ColumnLetter As String
Dim i As Integer

'Create Excel Application object
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets("Sheet1")

On Error GoTo HandleErr

' Create Excel Application object
''Set xlApp = New Excel.Application

' Create a new workbook
''Set xlBook = xlApp.Workbooks.Add

' Get rid of all but one worksheet
xlApp.DisplayAlerts = False
For i = xlBook.Worksheets.Count To 2 Step -1
xlBook.Worksheets(i).Delete
Next i
xlApp.DisplayAlerts = True

' Capture reference to first worksheet
''Set xlSheet = xlBook.ActiveSheet

' Change the worksheet name
xlSheet.Name = conSheetName

' Create recordset
Set rst = New ADODB.Recordset
rst.Open _
Source:=conQuery, _
ActiveConnection:=CurrentProject.Connection

With xlSheet
' Copy field names to Excel
' Bold the column headings
With xlSheet.Cells(1, 1)
.Value = rst.Fields(0).Name
.Font.Bold = True
End With
With xlSheet.Cells(1, 2)
.Value = rst.Fields(1).Name
.Font.Bold = True
End With
With xlSheet.Cells(1, 3)
.Value = rst.Fields(2).Name
.Font.Bold = True
End With
With xlSheet.Cells(1, 4)
.Value = rst.Fields(3).Name
.Font.Bold = True
End With
With xlSheet.Cells(1, 5)
.Value = rst.Fields(4).Name
.Font.Bold = True
'.WrapText = True
End With
With xlSheet.Cells(1, 6)
.Value = rst.Fields(5).Name
.Font.Bold = True
End With
With xlSheet.Cells(1, 7)
.Value = rst.Fields(6).Name
.Font.Bold = True
End With
With xlSheet.Cells(1, 8)
.Value = rst.Fields(7).Name
.Font.Bold = True
End With
With xlSheet.Cells(1, 9)
.Value = rst.Fields(8).Name
.Font.Bold = True
End With
With xlSheet.Cells(1, 10)
.Value = rst.Fields(9).Name
.Font.Bold = True
End With
With xlSheet.Cells(1, 11)
.Value = rst.Fields(10).Name
.Font.Bold = True
End With

' Copy all the data from the
' recordset into the spreadsheet.




xlApp.Visible = True



xlSheet.Range("A2").CopyFromRecordset rst

' Format the data
xlSheet.Columns("A:A").ColumnWidth = 9.67
xlSheet.Columns("B:B").ColumnWidth = 11.67
xlSheet.Columns("C:C").ColumnWidth = 11.67
xlSheet.Columns("D").ColumnWidth = 9.67
xlSheet.Columns("E:E").ColumnWidth = 42.67
xlSheet.Columns("F:F").ColumnWidth = 19.89
xlSheet.Columns("G:G").ColumnWidth = 14.89
xlSheet.Columns("H:H").ColumnWidth = 9.89
xlSheet.Columns("I:I").ColumnWidth = 16.89
xlSheet.Columns("J:J").ColumnWidth = 9.89
'.Columns("J:J").Select
' Selection.NumberFormat = "m/d/yyyy"
xlSheet.Columns("K:K").ColumnWidth = 9.89
'.Columns(11).AutoFit
'.Range("J2:J43").Select
'Selection.NumberFormat = "m/d/yyyy"
'.Range("A2").Select
'With .Columns(2)
' .NumberFormat = "#,##0"
' .AutoFit
'End With

End With

Call PageSet


With xlApp.ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False 'Force to use fit to page
.FitToPagesWide = 1
.FitToPagesTall = 5
.PrintGridlines = False
.LeftMargin = xlApp.InchesToPoints(0.25)
.RightMargin = xlApp.InchesToPoints(0.25)
.TopMargin = xlApp.InchesToPoints(1.65)
.BottomMargin = xlApp.InchesToPoints(0.25)

End With
xlApp.ActiveWindow.Caption = "Task Tracker"
xlApp.Application.Caption = "JTF-GNO/J5"
xlApp.Application.DisplayFormulaBar = False
xlApp.ActiveWindow.DisplayFormulas = False
xlApp.ActiveWindow.DisplayHeadings = False
xlApp.ActiveWindow.DisplayZeros = False

xlBook.Saved = True

xlApp.Visible = True

ExitHere:
On Error Resume Next
' Clean up
rst.Close
Set rst = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
'xlApp.Quit
Set xlApp = Nothing
Exit Sub

HandleErr:
MsgBox Err & ": " & Err.Description, , "Error in CreateExcelChart"
Resume ExitHere
Resume
End Sub

Thanks in advance...

 

[RoyVidar]

If you keep the PageSet routine, you'd need to either declare your excel object variables as public/private at the top of the module, or pass them to the PageSet routine. Then you need to prefix all of the Excel objects with the relevant object variables, as in this routine, or the thread I linked to. Either that, or copy the code from the PageSet routine into this one, in stead of calling it. In either case, you will need to fully qualify the references through your object variables.

Roy-Vidar

 

[Gaupo]

Thanks for the help, I have been away.
Sorry it took so long to reply with a thank you.....