Excel cell format problem when output from query

[huh?]

Hello all,

I have a macro (in access 2000 frontend talking to access 2000 backend) that is outputting a query to excel as follows:

MacroName Action
Cost-age OutputTo

Obect Type: Query
Object Name: Cost-Age
Output Format: MicrosoftExcel(*.xls)
Output File: C:\myfile.xls
Autostart: Yes
Template File:
Encoding:

Query:
SELECT [Cost-Age].[Age by Days], Format([Cost-Age].[Cost Sheet Number],"0.0") AS [Cost Sheet], Format([Cost-Age].Revenue,"$0.00") AS Revenue, Format([Cost-Age].Cost,"$0.00") AS Cost, [Cost-Age].[Invoice Printed], Format([Cost-Age].[Total File Revenue],"$0.00") AS [Total File Revenue], Format([Cost-Age].[Total File Cost],"$0.00") AS [Total File Cost]
FROM [Cost-Age]
ORDER BY [Cost-Age].[Age by Days] DESC, [Cost-Age].[Cost Sheet Number];

Query outputs to Excel, however all the number/currency fields are outputted as text and each cell has a green triangle in the left corner indicating this. If I select the fields in excel, right-click, and change the format of the fields to number or currency, the triangle still remains and I still cannot sum the cell contents.

What I would like is to output the numbers in access, as numbers in excel. Any help would be appreciated.

 

[Joe4]

Just like in Excel VBA, the function FORMAT converts an entry to Text. So if, you want the output to be numeric, do NOT use the FORMAT function.

In Query Builder, if you right-click on the Field Name down in the Query Builder box and select Properties, you can format the output as Currency there, though I am unsure if that will translate all the way through to your Excel file.

 

[huh?]

Thanks for the quick response Joe. Unfortunately that does not fix the problem when exporting to Excel. It does seem to be a common problem.

I have cobbled together a working solution. 2 links that I found useful in solving this problem are listed below:
http://cmiles.wordpress.com/2006/08/23/excel-number-stored-as-text/
http://www.dailydoseofexcel.com/archives/2006/02/18/number-stored-as-text/

Problems with Solution:
An excel process starts and remains running in the background, despite setting variables/objects to nothing, and despite closing the excel workbook. The process closes when access is closed. Any comments or help regarding this would be appreciated.

Solution explanation:
The code below can export any query you have created to an excel workbook of your choice.
Use of the DoCmd.TransferSpreadsheet avoids the "Error 3061: Too Few Parameters. Expected 2" error which results from using conditions in the WHERE portion of your query.
Lines starting from "With appexcel.FileSearch" to ".FileName = .FoundFiles(1)" can be replaced with a simple: myfile = "X:\myfolder\myfile.xls". You would also have to remove the "End If" and "End With" at the end.

Solution implementation:
If you are running the report from a button, change to the design view of the form, right-click on the button and click on properties. Click on the "Event" tab. Click on the space just to the right of the "On Click". Click on the little box that appears just to the right that says, "...". A new window will open. This is the Microsoft Visual Basic interface. Your cursor will automatically be at the right place. Type in:
ExportQuery ("YourQueryName")
i.e. ExportQuery ("Cost-Age")
Scroll down the upper left window of the Microsoft Visual Basic interface til you see the "Modules" folder. Right click on it, goto insert and click on "Module". Then copy and paste the code below into the new module, which will probably have a name like, "Module1".
Save everything.

Public Function ExportQuery(Queryname As String) As String

On Error GoTo err_Handler

Dim appexcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim WkshtName As String

' set to break on all errors
Application.SetOption "Error Trapping", 0

' Create the Excel Application
Set appexcel = Excel.Application

With appexcel.FileSearch
.NewSearch
.LookIn = "X:\myfolder" 'change this to your actual directory
.SearchSubFolders = False 'set to True if you want to search subfolders too
.FileName = "myfile.xls" 'change to your actual file

If .Execute() > 0 Then 'files found
.FileName = .FoundFiles(1) 'set / get the file name
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, Queryname, .FileName, True
'Create the Excel Workbook and Worksheet object
Set wbk = appexcel.workbooks.Open(.FileName)
WkshtName = Replace(Queryname, "-", "_")
WkshtName = Replace(WkshtName, " ", "_")
j = 1
For i = 1 To wbk.Worksheets.Count
Set wks = appexcel.Worksheets(j)
If (wks.Name <> WkshtName) Then
wks.Delete
Else: j = j + 1 'So can skip over outputted worksheet
End If
Next i
Set wks = appexcel.Worksheets(1)
wks.UsedRange.Value = Activesheet.UsedRange.Value
wks.Columns.AutoFit
appexcel.Visible = True
Else 'files not found
MsgBox "The X:\myfolder\myfile.xls file was not found.", vbCritical, "Error"
End If
End With

exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set appexcel = Nothing
Set WkshtName = Nothing
Set j = Nothing
Exit Function

err_Handler:
ExportQuery = Err.Description
MsgBox Prompt:=Err.Description
Resume exit_Here

End Function

 

[huh?]

I forgot to say that the critical line that fixes the problem is the following:

wks<b>.UsedRange.Value = Activesheet.UsedRange.Value</b>

 

[huh?]

Previously posted code had multiple problems. Below is the final solution. This code should work properly. Notice declaration of variables as objects, rather than specific Excel objects. Hope this helps others who have had this problem.


Option Explicit

Public Function ExportQuery(Queryname As String) As String

Dim appexcel As Object
Dim wbk As Object
Dim wks As Object
Dim WkshtName As String
Dim IStartedXL As Boolean

' set to break only on unhandled errors
Application.SetOption "Error Trapping", 2

' Create the Excel Application, Workbook and Worksheet
' Set appexcel = Excel.Application
On Error Resume Next
Set appexcel = GetObject(, "excel.application")
If Err.Number <> 0 Then
' no instance of excel, create one
Err.Clear
Set appexcel = CreateObject("excel.application")
If Err.Number <> 0 Then
MsgBox "Is Excel installed?"
On Error GoTo err_Handler
End If
IStartedXL = True
End If
On Error GoTo err_Handler

With appexcel.FileSearch
.NewSearch
.LookIn = "X:\myfolder" ' change this to your actual directory
.SearchSubFolders = False ' set to True if you want to search subfolders too
.FileName = "myfile.xls" 'changed HERE

If .Execute() > 0 Then ' files found
.FileName = .FoundFiles(1) ' set / get the file name
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Queryname, .FileName, True
Set wbk = appexcel.Workbooks.Open(.FileName)
appexcel.DisplayAlerts = False
appexcel.Visible = False
WkshtName = Replace(Queryname, "-", "_")
WkshtName = Replace(WkshtName, " ", "_")

With wbk
For Each wks In .Worksheets
If wks.Name <> WkshtName Then
wks.Delete
End If
Next wks
End With

appexcel.DisplayAlerts = True
Set wks = appexcel.Worksheets(1)
wks.UsedRange.Value = appexcel.ActiveSheet.UsedRange.Value
wks.Columns.AutoFit
appexcel.Visible = True
Else ' files not found
MsgBox "The X:\myfolder\myfile.xls file was not found.", vbCritical, "Error"
End If
End With

exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
'If IStartedXL Then appexcel.Quit
Set wks = Nothing
Set wbk = Nothing
Set appexcel = Nothing
WkshtName = ""
Exit Function

err_Handler:
ExportQuery = Err.Description
MsgBox Prompt:=Err.Description
DoCmd.Hourglass False
Resume exit_Here

End Function