I have pasted my code first part puts the info into excel and the second part formats the spreadsheet. I have closed the workbook. The workbook = xlbook
Thanks for having a look at this
Public Function fn_ExtractCustomerInfo() As Boolean
Dim db As Database
Dim rst As Recordset
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim sOutPut As String
Dim sTemplate As String
Dim x As Integer
Dim strFormat As String
Dim intFormat As Integer
Dim sTitle As String
Dim sCustomer As String
Dim dStart As Date
Dim dEnd As Date
Dim sAccount As String
'="Unit Sales by Date Range for " & [Forms]![frmSalesUnitPrice]![cboAccount].Column(2) & " from " & [Forms]![frmSalesUnitPrice]![txtStart] & " and " & [Forms]![frmSalesUnitPrice]![txtEnd]
sTitle = "Unit Sales by Date Range for "
sCustomer = [Forms]![frmSalesUnitPrice]![cboAccount].Column(2)
dStart = [Forms]![frmSalesUnitPrice]![txtStart]
dEnd = [Forms]![frmSalesUnitPrice]![txtEnd]
sAccount = [Forms]![frmSalesUnitPrice]![cboAccount].Column(1)
sTitle = sTitle & sCustomer & " from " & dStart & " and " & dEnd
x = 1
On Error GoTo Error_Handler:
sOutPut = "C:\StockOfferLog\CustomerHistoryExportTemplate.xls"
'FileCopy sTemplate, sOutPut
Set xlApp = CreateObject("Excel.Application")
'Set xlApp = New Excel.Application 'Open excel Application
'Set xlBook = xlApp.Workbooks.Add 'Open excel book with the application
Set xlBook = xlApp.Workbooks.Open(sOutPut)
Set xlsheet = xlBook.Worksheets("Sheet1")
xlsheet.Name = "Extract"
DoCmd.Hourglass True
Set db = CurrentDb 'Sets database object as the current database
Set rst = db.OpenRecordset("tblCustomerHistoryLastPriceExportTemp") 'opens query from where the data comes
xlsheet.Range("a1").Value = sTitle
xlsheet.Range("a2").Value = "Stock Code"
xlsheet.Range("b2").Value = "Stock Name"
xlsheet.Range("c2").Value = "FreeStock"
xlsheet.Range("d2").Value = "QTY Sold"
xlsheet.Range("e2").Value = "CurrencyCode"
xlsheet.Range("f2").Value = "Unit Price"
xlsheet.Range("g2").Value = "LastDate"
Do Until rst.EOF
' With rst
x = x + 1
' If Not rst.EOF Then 'If not end of file then execute the following
' xlSheet.Cells((x + 1), 1).Value = x
xlsheet.Cells((x + 1), 1).Value = rst("Stock Code")
xlsheet.Cells((x + 1), 2).Value = rst("Stock Name")
xlsheet.Cells((x + 1), 3).Value = rst("FreeStock")
xlsheet.Cells((x + 1), 4).Value = rst("QTY Sold")
xlsheet.Cells((x + 1), 5).Value = rst("CurrencyCode")
xlsheet.Cells((x + 1), 6).Value = rst("Unit Price")
xlsheet.Cells((x + 1), 7).Value = rst("LastDate")
rst.MoveNext
Loop
' End With
rst.Close 'Close recordset once program loop has finished.
DoCmd.SetWarnings False
db.Close
Set rst = Nothing 'Destroy the recordset object to free up memory space.
Set db = Nothing
Call FormatExcelExport
xlBook.SaveAs "C:\StockOfferLog\" & sAccount & "_" & Format(Date, "dd_mm_yyyy") & ".xls" 'Save the Excel file
xlBook.Close 'Close the Excel file.
' xlApp.Close
xlApp.Quit
Set xlApp = Nothing 'Destroy the Excel object created by the program to free up memory space.
Set xlsheet = Nothing
Set xlBook = Nothing
Exit_Line:
DoCmd.SetWarnings True
DoCmd.Hourglass False
Exit Function
Error_Handler:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Line
DoCmd.Quit
' DoCmd.Open
End Function
Sub FormatExcelExport()
'
' FormatExcelExport Macro
' Macro recorded 04/11/2008 by Admin
'
'
Range("A1").Select
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Font
.Name = "Arial Black"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1:G1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Rows("1:1").Select
Selection.RowHeight = 41.25
Columns("A:G").Select
Range("A2").Activate
Columns("A:G").EntireColumn.AutoFit
Range("A2:G2").Select
Selection.Font.Bold = True
Range("G3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "m/d/yyyy"
End Sub
