Hi Guys
I have a issue that I cant seem to get my head around, I have two forms Form (frm1) and (frm2) that both have a button on that when clicked exports a query to excel and formats the spread sheet automatically.
frm1 works great and also has the most complicated of the two queries exporting the data to excel
frm2 does not work when the button is press, the code always tells me there is no data to export
The code below runs on the "ExportToExcel" button click event of each form
The code on frm1 that works looks like this
Code:
Dim objExcelApp As Object
Dim objExcelBook As Object
Dim objExcelSheet As Object
Dim strSql As String
Dim objRecordSet As DAO.Recordset
Dim iRowStart As Integer
Const XLCENTER = -4108
Const XLLEFT = -4131 'xlRight is -4152
Const XLCELLVALUE = 1
Const XLGREATER = 5
' Const xlExpression = 2
Dim objO As Object
On Error Resume Next
Set objExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
' No Outlook is not open, try and create object
Err.Clear
Set objO = CreateObject("Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel Is Either Not Installed Or Is Unavalible You Can Not Export To Excel"
Err.Clear
Exit Sub
End If
End If
'Now we set up the SQL used for the Recordset (RS1)
strSql = "SELECT tblCustomers.fullname As [Customer Name], " & _
"Sum(Abs([DateofOrder] Between Date()-30 And Date())*[OrderTotalValue]) AS [Due Between Now And 30 Days], " & _
"Sum(Abs([DateofOrder] Between Date()-60 And Date()-31)*[OrderTotalValue]) AS [Due Between 30 And 60 Days], " & _
"Sum(Abs([DateofOrder] Between Date()-90 And Date()-61)*[OrderTotalValue]) AS [Due Between 60 And 90 Days], " & _
"Sum(Abs([DateofOrder] Between Date()-120 And Date()-91)*[OrderTotalValue]) AS [Due Between 90 And 120 Days], " & _
"Sum(Abs([DateofOrder]<Date()-121)*[OrderTotalValue]) AS [All OverDue Greater Than 120 Day], " & _
"[Due Between Now And 30 Days]+[Due Between 30 And 60 Days]+[Due Between 60 And 90 Days]+[Due Between 90 And 120 Days]+[All OverDue Greater Than 120 Day] AS [Total Outstanding]" & _
"FROM tblCustomers INNER JOIN tblOrders ON tblCustomers.CustomerID = tblOrders.CustomerID " & _
"GROUP BY tblCustomers.fullname, tblOrders.PaidInFull, tblOrders.HasBeenInvoiced, tblOrders.InvoiceVoided " & _
"HAVING (((tblOrders.PaidInFull)=False) AND ((tblOrders.HasBeenInvoiced)=True) AND ((tblOrders.InvoiceVoided)=False))"
'Execute query and populate recordset
Set objRecordSet = CurrentDb.OpenRecordset(strSql, dbOpenSnapshot)
'If no data, don't bother opening Excel, just quit
If objRecordSet.RecordCount = 0 Then
MsgBox "No Data Selected For Export", vbInformation + vbOKOnly, "No data exported"
DoCmd.Close acForm, "frmCompanyAgedDebtors", acSavePrompt
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 Refrences Required
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = False
Set objExcelBook = objExcelApp.Workbooks.Add() 'start a new workbook
Set objExcelSheet = objExcelBook.Worksheets(1)
With objExcelSheet
.Name = "Aged Debtors Report"
.Cells.font.Name = "Franklin Gothic Book"
.Cells.font.Size = 10
'Format using these examples .Columns("A").NumberFormat = "$#,##0.00;-$#,##0.00"
.Columns("B").NumberFormat = "$#,##0.00;-$#,##0.00"
.Columns("C").NumberFormat = "$#,##0.00;-$#,##0.00"
.Columns("D").NumberFormat = "$#,##0.00;-$#,##0.00"
.Columns("E").NumberFormat = "$#,##0.00;-$#,##0.00"
.Columns("F").NumberFormat = "$#,##0.00;-$#,##0.00"
.Columns("G").NumberFormat = "$#,##0.00;-$#,##0.00"
.Columns("H").NumberFormat = "$#,##0.00;-$#,##0.00"
'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 = DLookup("[CompanyName]", "[tblCompanyDetails]", "[CompanyID]=1") & " " & "Aged Debtors Report" '= "Company Aged Creditors Report"
.Range("A2").Value = Date
'Now We Shall Build The Colum Headings.value is the text required
.Range("A4").Value = "Customer Name "
.Range("A4").HorizontalAlignment = XLLEFT
.Range("A4").Columns.AutoFit
.Range("B4").Value = "Due Between Now And 30 Days"
.Range("C4").Value = "Due Between 30 And 60 Days"
.Range("D4").Value = "Due Between 60 And 90 Days"
.Range("E4").Value = "Due Between 90 And 120 Days"
.Range("F4").Value = "All OverDue Greater Than 120 Day"
.Range("G4").Value = "Total Outstanding"
.Range("H4").Value = "Total Payment Due"
'Format Column Headings set the text to the left on A4 so it looks nice, then center the values in the range B7:G3000 so all values are centered
.Range("A4").HorizontalAlignment = XLLEFT
.Range("B:G").HorizontalAlignment = XLCENTER
'Then We set the withs to auto fit the comlum names nicely, to Bold you can use this on a seperate line .Range("A4:G4").Cells.Font.Bold = True
.Range("A4").Columns.AutoFit
.Range("B4").Columns.AutoFit
.Range("C4").Columns.AutoFit
.Range("D4").Columns.AutoFit
.Range("E4").Columns.AutoFit
.Range("F4").Columns.AutoFit
.Range("G4").Columns.AutoFit
.Range("H4").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 objRecordSet.EOF
'center align the Headers between B4 and G4
.Range("B4:G4").HorizontalAlignment = XLCENTER
'fit the with of the A7 to fit the width of the widest supplier name
.Range("A7").Columns.AutoFit
'then we center the results
.Range("B7:H7").HorizontalAlignment = XLCENTER
'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(objRecordSet![Customer Name], "")
.Range("B" & iRowStart).Value = Nz(objRecordSet![Due Between Now And 30 Days], "")
.Range("C" & iRowStart).Value = Nz(objRecordSet![Due Between 30 And 60 Days], 0)
.Range("D" & iRowStart).Value = Nz(objRecordSet![Due Between 60 And 90 Days], 0)
.Range("E" & iRowStart).Value = Nz(objRecordSet![Due Between 90 And 120 Days], 0)
.Range("F" & iRowStart).Value = Nz(objRecordSet![All OverDue Greater Than 120 Day], 0)
.Range("G" & iRowStart).Value = Nz(objRecordSet![Total Outstanding], 0)
iRowStart = iRowStart + 1
objRecordSet.MoveNext
Loop
'Now We Add Some Nice Conditional Formatting, Text Will Re Red If Value Greater Than Zero
With .Range("B7:G3000").FormatConditions.Add(XLCELLVALUE, XLGREATER, 0)
.font.color = RGB(255, 53, 53)
End With
'Then we calculate the total Payments required to Supplier
.Range("H7").Formula = "=SUM($G7:$G65000)"
.Range("H7").font.color = vbRed
'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 = "These Are All The Payments Outstanding That You Are Due To Receive."
.Range("A" & iRowStart).font.color = vbRed
End With
DoCmd.Hourglass False
objExcelApp.Visible = True
objRecordSet.Close
Set objRecordSet = Nothing
Set objExcelApp = Nothing
Set objExcelBook = Nothing
Set objExcelSheet = Nothing
On Error GoTo 0
Exit Sub
End If
The code on frm2 that always tells me there is no data to export looks like this, it always shows the msgbox highlighted in red
Code:
Dim objExcelApp As Object
Dim objExcelBook As Object
Dim objExcelSheet As Object
Dim strSql As String
Dim objRecordSet As DAO.Recordset
Dim iRowStart As Integer
Const XLCENTER = -4108
Const XLLEFT = -4131 'xlRight is -4152
Const XLCELLVALUE = 1
Const XLGREATER = 5
' Const xlExpression = 2
Dim objO As Object
On Error Resume Next
Set objExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
' No Outlook is not open, try and create object
Err.Clear
Set objO = CreateObject("Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel Is Either Not Installed Or Is Unavalible You Can Not Export To Excel"
Err.Clear
Exit Sub
End If
End If
'Now we set up the SQL used for the Recordset (RS1)
strSql = "SELECT tblCustomers.FullName AS [Customer Name], Count(tblAccountTransactions.ID) AS [Number Of Paid Invoices], Sum(tblAccountTransactions.TotalPayment), " & _
"AS [Total Income], Avg(tblAccountTransactions.TotalPayment) AS [Average Income], " & _
"FROM tblAccountTransactions INNER JOIN tblCustomers ON tblAccountTransactions.CustomerID = tblCustomers.CustomerID" & _
"GROUP BY tblCustomers.FullName, tblAccountTransactions.CustomerID"
'Execute query and populate recordset
Set objRecordSet = CurrentDb.OpenRecordset(strSql, dbOpenSnapshot)
'If no data, don't bother opening Excel, just quit
If objRecordSet.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 Refrences Required
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = False
Set objExcelBook = objExcelApp.Workbooks.Add() 'start a new workbook
Set objExcelSheet = objExcelBook.Worksheets(1)
With objExcelSheet
.Name = "Customer Sales Report"
.Cells.font.Name = "Arial"
.Cells.font.Size = 10
'Format using these examples .Columns("A").NumberFormat = "$#,##0.00;-$#,##0.00"
.Columns("C").NumberFormat = "$#,##0.00;-$#,##0.00"
.Columns("D").NumberFormat = "$#,##0.00;-$#,##0.00"
'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 = "Arial"
.Range("A2").Cells.font.Name = "Arial"
.Range("A1").Cells.font.Size = 12
.Range("A2").Cells.font.Size = 10
.Range("A1").Value = DLookup("[CompanyName]", "[tblCompanyDetails]", "[CompanyID]=1") & " " & "Customer Sales Report"
.Range("A2").Value = Date
'Now We Shall Build The Colum Headings.value is the text required
.Range("A4").Value = "Customer Name"
.Range("A4").HorizontalAlignment = XLLEFT
.Range("A4").Columns.AutoFit
.Range("B4").Value = "Number Of Paid Invoices"
.Range("C4").Value = "Total Income"
.Range("D4").Value = "Average Income"
'Format Column Headings set the text to the left on A4 so it looks nice, then center the values in the range B7:G3000 so all values are centered
.Range("A4").HorizontalAlignment = XLLEFT
.Range("B:D").HorizontalAlignment = XLCENTER
'Then We set the withs to auto fit the comlum names nicely, to Bold you can use this on a seperate line .Range("A4:G4").Cells.Font.Bold = True
.Range("A4").Columns.AutoFit
.Range("B4").Columns.AutoFit
.Range("C4").Columns.AutoFit
.Range("D4").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 objRecordSet.EOF
'center align the Headers between B4 and G4
.Range("B4:G4").HorizontalAlignment = XLCENTER
'fit the with of the A7 to fit the width of the widest supplier name
.Range("A7").Columns.AutoFit
'then we center the results
.Range("B7:D7").HorizontalAlignment = XLCENTER
'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(objRecordSet![Customer Name], "")
.Range("B" & iRowStart).Value = Nz(objRecordSet![Number Of Paid Invoices], "")
.Range("C" & iRowStart).Value = Nz(objRecordSet![Total Income], 0)
.Range("D" & iRowStart).Value = Nz(objRecordSet![Average Income], 0)
iRowStart = iRowStart + 1
objRecordSet.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 = "Customer Sales Report."
.Range("A" & iRowStart).font.color = vbRed
End With
DoCmd.Hourglass False
objExcelApp.Visible = True
objRecordSet.Close
Set objRecordSet = Nothing
Set objExcelApp = Nothing
Set objExcelBook = Nothing
Set objExcelSheet = Nothing
End If
If I run the query from frm2 in the query designer the required data is shown as expected, I cant for the life of me work out why this is happening
Any help would be fantastic
steve