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