Hi Guys
I have this code that runs on a button click that exports a query to excel with formatting
Code:
Dim objXlApp As Object
Dim objXlBook As Object
Dim objXlSheet As Object
Dim strSql As String
Dim objRs1 As DAO.Recordset 'This Is A Object
Dim iRowStart As Integer
Const XLCENTER = -4108
Const XLLEFT = -4131 'xlRight is -4152
Const XLCELLVALUE = 1
Const XLLESSEQUAL = 8
Const XLEQUAL = 3
Const xlGreater = 5
Const xlExpression = 2
Dim objExcel As Object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
' No Outlook is not open, try and create object
Err.Clear
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel Is Either Not Installed or Is Unavailable You Can Not Export to Excel"
Err.Clear
Exit Sub
End If
End If
strSql = "SELECT AssetNotesType.NoteType, qryITHelpDeskResponceTimeByIssue.[Actual Time], qryITHelpDeskHoldTimeByIssue.[Hold Time] AS HoldTime, [Actual Time]-[HoldTime]) AS [Total Minutes], " & _
"qryITHelpDeskResponceTimeByIssue.CountOfAssetNotesID AS [Number Of Tickets], ([Total Minutes]/[Number Of Tickets]) AS [Avg Minutes], " & _
"[AVG Minutes] AS [Average Hours], Minutes2Duration([Total Minutes]) AS [Formatted Hour], Minutes2Duration([Average Hours]) AS , " & _
"[Formatted Average Hours], " & _
"FROM (AssetNotesType LEFT JOIN qryITHelpDeskHoldTimeByIssue ON AssetNotesType.ID = qryITHelpDeskHoldTimeByIssue.ID) , " & _
"RIGHT JOIN qryITHelpDeskResponceTimeByIssue ON AssetNotesType.ID = qryITHelpDeskResponceTimeByIssue.ID, " & _
"ORDER BY qryITHelpDeskResponceTimeByIssue.CountOfAssetNotesID DESC"
'Execute query and populate recordset
Set objRs1 = CurrentDb.OpenRecordset(strSql, dbOpenSnapshot)
'If no data, don't bother opening Excel, just quit
If objRs1.RecordCount = 0 Then
MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
Exit Sub
Else
'We Shall Turn On The Hour Glass, So That Users Know That Something Is Happening
DoCmd.Hourglass (True)
'Create an instance of Excel and start building a spreadsheet Late Binding Used So No References Required
Set objXlApp = CreateObject("Excel.Application")
objXlApp.Visible = False
Set objXlBook = objXlApp.Workbooks.Add() 'start a new workbook
Set objXlSheet = objXlBook.Worksheets(1)
With objXlSheet
.Name = "Asset Report"
.Cells.Font.Name = "Franklin Gothic Book"
.Cells.Font.Size = 10
'
'Format range as required To Bold a Cell use this for example .Range("A1").Cells.Font.Bold = True
.Range("A1", "H1").Merge
.Range("A1").Columns.AutoFit
.Range("A2", "H2").Merge
.Range("A2").Columns.AutoFit
.Range("A1").HorizontalAlignment = XLLEFT
.Range("A2").HorizontalAlignment = XLLEFT
.Range("A1").Cells.Font.Name = "Franklin Gothic Book"
.Range("A2").Cells.Font.Name = "Franklin Gothic Book"
.Range("A1").Cells.Font.Size = 12
.Range("A2").Cells.Font.Size = 10
.Range("A1").Value = "Report Required"
.Range("A2").Value = "Exported ON" & " - " & Date
'
'Now We Shall Build The Colum Headings.value is the text required
.Range("A4").Value = "Note Type"
.Range("B4").Value = "Acutal Time"
.Range("C4").Value = "Hold Time"
.Range("D4").Value = "Total Minutes"
.Range("E4").Value = "Number Of Tickets"
.Range("F4").Value = "Avg Minutes"
.Range("G4").Value = "Average Hours"
.Range("H4").Value = "Formatted Hours"
.Range("i4").Value = "Formatted Average Hours"
'Format Column Headings set the text to the left on A4 so it looks nice, then center the values in the range B7:I3000 so all values are centered
.Range("A4:l4").Cells.Font.Bold = True
.Range("A4:l4").HorizontalAlignment = XLCENTER
.Range("A4:l4").Columns.AutoFit
'iRowStart is the row that the starting row that the recordset will enter data into
iRowStart = 7
'Then we Loop through recordset above and copy data from recordset until we get to the end of file
Do While Not objRs1.EOF
'
'start importing the data from the record set above into the required columns A,B,C,D,E,F,G in this example
.Range("A" & iRowStart).Value = Nz(objRs1![NoteType], "")
.Range("A" & iRowStart).Columns.AutoFit
.Range("A" & iRowStart).HorizontalAlignment = XLCENTER
.Range("A" & iRowStart).ColumnWidth = 15
.Range("B" & iRowStart).Value = Nz(objRs1![Actual Time], "")
.Range("B" & iRowStart).Columns.AutoFit
.Range("B" & iRowStart).HorizontalAlignment = XLCENTER
.Range("B" & iRowStart).ColumnWidth = 18
.Range("C" & iRowStart).Value = Nz(objRs1![Hold Time], 0)
.Range("C" & iRowStart).Columns.AutoFit
.Range("C" & iRowStart).HorizontalAlignment = XLCENTER
.Range("C" & iRowStart).ColumnWidth = 15
.Range("D" & iRowStart).Value = Nz(objRs1![Total Minutes], 0)
.Range("D" & iRowStart).Columns.AutoFit
.Range("D" & iRowStart).HorizontalAlignment = XLCENTER
.Range("D" & iRowStart).ColumnWidth = 20
'
.Range("E" & iRowStart).Value = Nz(objRs1![Number Of Tickets], 0)
.Range("E" & iRowStart).Columns.AutoFit
.Range("E" & iRowStart).HorizontalAlignment = XLCENTER
.Range("E" & iRowStart).ColumnWidth = 15
.Range("F" & iRowStart).Value = Nz(objRs1![Avg Minutes], 0)
.Range("F" & iRowStart).Columns.AutoFit
.Range("F" & iRowStart).HorizontalAlignment = XLCENTER
.Range("F" & iRowStart).ColumnWidth = 20
'
.Range("G" & iRowStart).Value = Nz(objRs1![Average Hours], 0)
.Range("G" & iRowStart).Columns.AutoFit
.Range("G" & iRowStart).HorizontalAlignment = XLCENTER
.Range("G" & iRowStart).ColumnWidth = 20
'
.Range("H" & iRowStart).Value = Nz(objRs1![Formatted Hours], 0)
.Range("H" & iRowStart).Columns.AutoFit
.Range("H" & iRowStart).HorizontalAlignment = XLCENTER
.Range("H" & iRowStart).ColumnWidth = 28
'
.Range("I" & iRowStart).Value = Nz(objRs1![Formatted Average Hours], 0)
.Range("I" & iRowStart).Columns.AutoFit
.Range("I" & iRowStart).HorizontalAlignment = XLCENTER
.Range("I" & iRowStart).ColumnWidth = 20
iRowStart = iRowStart + 1
objRs1.MoveNext
Loop
'
'then we set a footer, we start this two rows below the last entry and leave a gap of 3 rows and format the footer nicely
iRowStart = iRowStart + 2
.Range("A" & iRowStart).Value = "All Data Exported All Times Shown Have been Formatted to the following D:H:M"
.Range("A" & iRowStart).Font.Color = vbRed
.Range("A" & iRowStart).HorizontalAlignment = XLLEFT
End With
DoCmd.Hourglass False
objXlApp.Visible = True
objRs1.Close
Set objRs1 = Nothing
Set objXlApp = Nothing
Set objXlBook = Nothing
Set objXlSheet = Nothing
On Error GoTo 0
Exit Sub
End If
when I run the code, it fires this code
Code:
'If no data, don't bother opening Excel, just quit
If objRs1.RecordCount = 0 Then
MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
Exit Sub
Else
if I export the data to exel with this command
Code:
DoCmd.OutputTo acOutputQuery, "qryITHelpDeskTicketResolutionTimes", acFormatXLS, DLookup("FilePath", "Settings", "ID = 1") & "\IT" & "\Reports" & "\Issues By Average Time" & "\" & Me.DateRangetxtBox & ".xls"
' Application.FollowHyperlink (DLookup("FilePath", "Settings", "ID = 1")) & "\IT" & "\Reports" & "\Issues By Average Time" & "\" & Me.DateRangetxtBox & ".xls"
it works correctly
both query's are the same I'm a bit confused as to what I have missed
any help will be great