Export Query to Excel Keeping Formatting

[mdray00]

Hi,

I have several queries that I want to export to Excel.

However when I i use the DoCmd.TransferSpreadsheet acExport command it exports but removes all formatting.

A few of the columns are Currency is there any way to export and maintain the format that they are in access?

Thanks

Mike

 

[Rx_]

No with DoCmd.transferspreadsheet - it is just a dumb transfer. Built-in one-size-fits-all.

One way is to push it into a template.
My suggestion is to use this more complex method.

http://www.btabdevelopment.com/ts/default.aspx?PageId=48
Suggest that you embrace coding to take total control of your Excel outputs.
Once you have mastered the code on the link above, if Column B needed to be set to currency, the code to add would something like this.

APXL.Columns("B:B").Select
With ApXL.Selection
.NumberFormat = "$#,##0.00"
end with
After using code with a query to bring over the data to Excel, a set of code can be used to make very verbose reports.
This is sometimes called "Topping Off" the data transfer.

I never use the Access reports. Everything is in Excel.
The Data Headers always start on line 5. This leaves room on top to add custom formulas for a Dashboard. Since the number of records returned is known, the formulas are customized.
Each user selects the criteria for each Excel Report. The resulting report is named and time stamped. The name includes the parameter criteria selected by the user.
The report is then saved on a network location - under each Users Folder, then under the Report name. Basically a filing system.

The attachment shows a typical report. Cell B4 has a custom formula designed for the exact number of records returned.
You can make out the Bold and light rows that indicate the latest and multiple records. The Filters allow things like Bold only, and other column filters. The formula can count only those visible, only those bold and just about anything else a regulatory manager can think of.
More important: These Smart Excel reports allow managers to perform live "what if" decisions during meetings.

While you won't start doing this level of Excel day one, learning the basics from the web site above will be very useful to your career.

This is a long-winded explanation. This same question is asked several times a month. This link might be re-posted. Otherwise, I might turn into one of those Pirate's Parrot.

 

[mdlueck]

The way to keep formatting is to:

1) Create a empty spreadsheet with all of the formatting in place
2) In Access VBA, make a copy of that template file to the target filename (I use the MSO SaveAs dialog box to accept a target filename), and make a copy of the template to that filename
3) Then use this suggestion to transfer the data to the spreadsheet:

How to drive Excel with VBA (Access) in order to transfer values into spreadsheet
http://www.access-programmers.co.uk/forums/showthread.php?t=233104#post1190025

 

[Antanas_07]

Dear Rx,
When I read your comment I feel like a poppet in the school. But I am probably the one who does not understands lesson when everybody does. And I will explain why every month there is an inquiry about query transformation to Excel. BECAUSE there is no clear answer. Majority (and I am on the case big time) forum supports are useless with comments after n+1 lines of code saying "well guys I am not sure if it works", or "sorry guys never tested" and now yours "once you mastered the code". And true the "DoCmd.transferspreadsheet " works like diarrhea but you know what - funny enough IT DOES EXECUTE THE COMMAND. I understand I have to carry my own cross through this and I work hard, but after several attempts "mastering the code" somehow begun to smell. the "Argument Not optional" all over the place. I opened a new Module, named it ExportXLS and placed it under onClick event. Well I hope for help.

 

[Antanas_07]

As Usual:
"Argument Not Optional" sorted with OnClick
Call SendTQ2Excel(strTQName, strSheetName)
then next - "Too few parameters. Expected 2" - still "mastering"

 

[Antanas_07]

Hi Again still "mastering". Finally realised that if you have query without Caption in columns the code runs.... Exactly like DoCmd.transferspreadsheet (but thanks God finally the code does give me an Excel document with pre-set Sheet name) . A control of cells perhaps in Excel (did not tried as I am half way to export query). I am still "mastering" the code to have names of query columns in Excel, as they named in my query in Access when I run it (Field 'CCNo' Caption 'Complaint No' and so on 20+ fields). Any Help to make this once and forever clear?

 

[Antanas_07]

Sorry to disturb the silence again, but I am confident, that the initial question from MDRAY00 has not been answered. the question was about "exports removes all formatting".
But the answer somehow slipped to excel formatting. It is not about excel formatting. It is about loosing formatting during export. Not formatting exported. I would rephrase the question. Exporting query from Ribon there is a formatting option which you select and it does the trick. So when MDRAY00 used the Ribon export Option there was formatting, but using DoCmd.TransferSpreadsheet formatting is gone. So Thanks for a sample of code but it does not gives an answer to the question. After thorough research it looks like not many people knows the answer. Please prove me wrong.

 

[Antanas_07]

Hi, Sorry for being a bit desperate. If anybody interested, I would give my version of solving my problem and possibly many others.
The problem ocures when you (me) want to transfer Report Data fro Access in to Excel. And there is no easy way to do so. So one of solutions I had to make: create a simple Query with all Data listed in Report. You (me) will face 2 problems: 1. there is no clear way to transfer Query to Exel, and Report columns often Named in different names (names which makes more sense to the end user) then in Query columns. As in Designe we use CCNo, but not Complaint Number.
1. The Code to transfer values is proposed above by mr.Rx actualy works greate. Just this "mastering" bit. what I done is placed the code in a new module and named with my name, then call the function (event OnClick) (Attention!):
Call SendTQ2Excel(strTQName, strSheetName)
2. If poor colegs following my way and have a query to export, I strongly suggest to create a Test Simple Query with plain column names without Caption (where 2-3 columns: IDNo, Name, Surname) and test the code with the Test Query. When it works and you feel Sweet Victory, make it more complicated: correct query SQL by clicking on SQL View of Test Query. supply every simple column with additional bit:
instead tblCustomers.IDNo write tblCustomers.IDNo As [Customer Number] and so on.
Run the function now, and will see the column names just as you wish them to be.
Now difficult part: Come back to Your desired query which you want to export (in my case I build special Report Querys) and correct it with Columns Names.
I still working on it (this mastering bit in excel). And running out of time as Project Presentation in days
Hope my not so prffesional advice will save to someone some time.

 

[Antanas_07]

Saga of Exporting query still continues. I have a query which in normal conditions would ask for parameters in dialog box. After introducing the Code I got famost "Too few parameters. Expected 2". Any help how overcome the obsticle would be appriciated. Thanks in Advance

 

[Rx_]

http://support.microsoft.com/kb/269671 for the too few parameters expected.

Sounds like you have the query working in the query window (asking for parameters).
The code version results in an error.
Can you use the code tags and post the code version? Sometimes it is just a translation of a double quote into a single quote, space, or other character translation.

Don't know what your time zone is. I am heading to Vail,CO for the GoPro competition in about 2 hours. At least the code will let me or others propose a solution for the Too Few parameters. Expected x

 

[Antanas_07]

Hi thanks for respond. Long story short: the code I run - No surprises:

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

strTQName = "qryExcelReport" ' My Bits
strSheetName = "MonthlyReport" 'My again

On Error GoTo err_handler
Set rst = CurrentDb.OpenRecordset(strTQName)
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetName) > 0 Then
xlWSh.Name = Left(strSheetName, 34)
End If
xlWSh.Activate
xlWSh.Range("A1").Select

For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst.Close
Set rst = Nothing 'I do not go for the Exel formatting until fix query problem

And the End

The query exports fine up to the point when I add field CurrentYear and in Criteria place this line:
Like [Please Enter Year No: like_ YYYY_ four digits format] & "*"
As soon as add this line it say Too...... Game over
Thanks in advance. I will be full time near computer.

 

[Rx_]

Sorry to take so long. Actually not that sorry, the GoPro event in Vail, CO was fantastic!

rst - lets break this down.
where:
Dim strDataED_EMWellSumRpt As DAO.Recordset


Note my string - strSQLED_EMWellSumRpt (Am I verbose or what?) ED is Environmental eMission Well Summary Report -

Go to your Query with the parameter - put in some date and run it. Look at it with the SQL view.
Past that SQL text into the code to assign it to a variable. Don't worry, we will fix the date to be a variable.

Instead of putting the date in the query, we are going to pass the date into your code
Here is an example of how an Area code was passed to the sql code:
strSQLStip = strSQLStip & " where (([0012A_Stip].ID_Area) " & ID_Area & ") "
We will do the same with the date.

The advantage of this is: if anyone mucks with your Query in Access, it won't affect your code.

Another tip:
Put a break point right after the SQL String is assigned to the variable. Then copy and past the resulting string into a new query in SQL view. It should run. This simple concept of having the SQL statement in code can provide you with some very powerful options later.

90    strSQLED_EMWellSumRpt = ""
100   strSQLED_EMWellSumRpt = strSQLED_EMWellSumRpt & "SELECT AA12MoReport.ID_Wells, AA12MoReport.[Well Name], Sum(AA12MoReport.[Tank Throughput]) AS [Tank Throughput], Sum(AA12MoReport.UnControlled) AS [Un Controlled],  "
110   strSQLED_EMWellSumRpt = strSQLED_EMWellSumRpt & " Sum(AA12MoReport.[Actual Controlled]) AS [Actual Controlled], First(AA12MoReport.Controlled) AS Controlled, Max(AA12MoReport.Efficiency) AS Efficiency, "
120   strSQLED_EMWellSumRpt = strSQLED_EMWellSumRpt & " Max(AA12MoReport.[Tank Updated]) AS [Tank Updated], Sum(AA12MoReport.[Flare Throughput]) AS [Flare Throughput], Sum(AA12MoReport.NOx) AS NOx, Sum(AA12MoReport.CO) AS CO, "
130   strSQLED_EMWellSumRpt = strSQLED_EMWellSumRpt & " Sum(AA12MoReport.VOC) AS VOC, Max(AA12MoReport.[BTU Rating]) AS [BTU Rating], Max(AA12MoReport.MolWeight) AS [Mol Weight], Max(AA12MoReport.VOCWeight) AS [VOC Weight], "
140   strSQLED_EMWellSumRpt = strSQLED_EMWellSumRpt & " Max(AA12MoReport.[Flare Updated]) AS [Flare Updated], Max(AA12MoReport.[Well Status]) AS [Well Status] "
150   strSQLED_EMWellSumRpt = strSQLED_EMWellSumRpt & " FROM AA12MoReport "
160   strSQLED_EMWellSumRpt = strSQLED_EMWellSumRpt & " GROUP BY AA12MoReport.ID_Wells, AA12MoReport.[Well Name] "
170   strSQLED_EMWellSumRpt = strSQLED_EMWellSumRpt & " ORDER BY AA12MoReport.ID_Wells; "




180         Set strDataED_EMWellSumRpt = CurrentDb.OpenRecordset(strSQLED_EMWellSumRpt, dbOpenSnapshot, dbReadOnly + dbSeeChanges) ' suggestion was this could be faster but it is not
190           If strDataED_EMWellSumRpt.RecordCount < 1 Then
200               MsgBox "There are no records for the selected criteria", vbOKOnly, "No Records - No Report   a.k.a. no shoes, no shirt, no service"
                
220               Exit Function
230           End If



560     intWorksheetNum = 1
570     intRowPos = 1
580        ObjXL.Worksheets(intWorksheetNum).Name = WorkSheetName
590         intRowPos = 6                                                                                 ' Sets starting Row for data in Excel at Row 6 - reference fields to this

610         ObjXL.DisplayAlerts = False      ' VERY IMPORTANT Turn off Display Alerts
620         ObjXL.Worksheets(intWorksheetNum).Cells(intRowPos, 1).CopyFromRecordset strDataED_EMWellSumRpt
630         DoEvents
640         intMaxRecordCount = strDataED_EMWellSumRpt.RecordCount - 1                                                      ' - use for max rows returned in formatting later
           'Debug.Print "max record count is " & intMaxRecordCount
                                                        ' ------- Create Header in new Excel based on Query
650       intMaxheaderColCount = strDataED_EMWellSumRpt.Fields.count - 1
660       For intHeaderColCount = 0 To intMaxheaderColCount
670           If Left(strDataED_EMWellSumRpt.Fields(intMaxheaderColCount).Name, 3) <> "xxx" Then  ' Future use - adding xxx in cross tab queries for fields to exclude
680               ObjXL.Worksheets(intWorksheetNum).Cells(intRowPos - 1, intHeaderColCount + 1) = strDataED_EMWellSumRpt.Fields(intHeaderColCount).Name    ' Relative to intRowPos
690           End If
700       Next intHeaderColCount
          'Debug.Print "Columns created count is " & intHeaderColCount
710       ObjXL.Rows((intRowPos - 1) & ":" & (intRowPos - 1)).Select                                    ' Selection for Bold header column (can make 2 if needed)

 

[Antanas_07]

Hi Rx
Thanks for still beeing with my, I will concentrate in the evening (I am in UK) on the Database. For now I could tell I admire your proffesional aproach. Thanks again. Can't wait untill I will read every single word you wrote. And will follow the advice.
Antanas

 

[Rx_]

You might have noticed the Exit Function
My reports are Functions that start with an assignment of FALSE and return a TRUE if it makes it to the end of creating an Excel report.

This way, when it is called from a button, a True or False is returned.
Will check in at end of the day.

 

[Antanas_07]

Hi Rx,
I Obviously did work a bit on the suggestions. First of all SORRY, I did not include strSQLED_EMWellSumRpt, BUT I created a module and named it DxED_Monthly. Then I built a form with TextBoxes Text0 and Text2 and button which calls the function. The way I placed an SQL in vba a bit different. the code does not work up to the end and it stopes in "Set rstDataMonthlyReport....." Comes up with miss match error message. Anyway I copied the code. PLS Disregard previous sample I mentioned above - it works WELL with insignificant a few additional bits to Excel (set up the width of cells to fit in to A3 format), this is a different query:
Public Function MonthlyReport()
Dim rstDataMonthlyRpt As DAO.Recordset
Dim strSQLMonthlyRpt As String
Dim WorkSheetName As String
Dim intHeaderColCount As Integer
Dim intMaxheaderColCount As Integer
Dim intMaxRecordCount As Integer
Dim intWorksheetNum As Integer
Dim intRowPos As Integer
Dim ObjXL As Object

strSQLMonthlyRpt = "SELECT tblCCQualityMain.[Prefix], tblCCQualityMain.CCNo, tblCCQualityMain.[FrontBack], tblComplaintDetails.[ComplaintOpenDate], tblComplaintDetails.[OpenedBy], tblCCQualityMain.[DefineProblemCheck], tblCCQualityMain.[ContainmentActionCheck], tblCCQualityMain.[RootCauseCheck], tblCCQualityMain.[Action2WeeksOKCheck], tblCCQualityMain.[CorrectiveActionCheck], tblCCQualityMain.[ImpementingCorActCheck], [tblCCQualityMain].[ComplaintOpenDate]+19 AS TargetDate, tblCCQualityMain.[DateOfClosure], " & _
"tblCalendar.[DateYear], tblRootCause.[RootCause], tblCCQualityMain.[TimeForQualityActionsTaken], [tblCCQualityMain].[WholeCCTime]/[tblCCQualityMain].[TimeForQualityActionsTaken]*100 AS Performance, tblCalendar.[MonthNo], tblComplaintDetails.[Rectified], tblComplaintDetails.[ProblemDefined], tblComplaintDetails.[DeletedComplaint], tblContainmentAction.[ContainmentAction], qryDefineProblem1.[Description1], tblContainmentAction.[PersonResponsible], tblCorrectiveAction.[ResponsiblePerson], tblCorrectiveAction.[ActionDetails] " & _
"FROM ((tblRootCause RIGHT JOIN (tblCalendar RIGHT JOIN (tblComplaintDetails RIGHT JOIN (tblCorrectiveAction RIGHT JOIN tblCCQualityMain ON tblCorrectiveAction.CCNo = tblCCQualityMain.CCNo) ON tblComplaintDetails.CCNo = tblCCQualityMain.CCNo) ON tblCalendar.DayDate = tblCCQualityMain.ComplaintOpenDate) ON tblRootCause.CCNo = tblCCQualityMain.CCNo) INNER JOIN tblContainmentAction ON tblCCQualityMain.CCNo = tblContainmentAction.CCNo) INNER JOIN qryDefineProblem1 ON tblCCQualityMain.CCNo = qryDefineProblem1.CCno " & _
"Where tblCalendar.[DateYear]='" & Forms![frmMonthlyReportSelect].Text0.Value & "' AND tblCalendar.MonthNo='" & Forms![frmMonthlyReportSelect].Text2.Value & "' " & _
"ORDER BY tblCCQualityMain.CCNo; "


Set rstDataMonthlyRpt = CurrentDb.OpenRecordset(strSQLMonthlyRpt, dbOpenSnapshot, dbReadOnly + dbSeeChanges) ' suggestion was this could be faster but it is not
If rstDataMonthlyRpt.RecordCount < 1 Then
MsgBox "There are no records for the selected criteria", vbOKOnly, "No Records - No Report a.k.a. no shoes, no shirt, no service"

Exit Function
End If

intWorksheetNum = 1
intRowPos = 1
ObjXL.Worksheets(intWorksheetNum).Name = WorkSheetName
intRowPos = 6 ' Sets starting Row for data in Excel at Row 6 - reference fields to this
ObjXL.DisplayAlerts = False ' VERY IMPORTANT Turn off Display Alerts
ObjXL.Worksheets(intWorksheetNum).Cells(intRowPos, 1).CopyFromRecordset rstDataMonthlyRpt
DoEvents
intMaxRecordCount = rstDataMonthlyRpt.RecordCount - 1 ' - use for max rows returned in formatting later
'Debug.Print "max record count is " & intMaxRecordCount
' ------- Create Header in new Excel based on Query
intMaxheaderColCount = rstDataMonthlyRpt.Fields.Count - 1
For intHeaderColCount = 0 To intMaxheaderColCount
If Left(rstDataMonthlyRpt.Fields(intMaxheaderColCount).Name, 3) <> "xxx" Then ' Future use - adding xxx in cross tab queries for fields to exclude
ObjXL.Worksheets(intWorksheetNum).Cells(intRowPos - 1, intHeaderColCount + 1) = rstDataMonthlyRpt.Fields(intHeaderColCount).Name ' Relative to intRowPos
End If
Next intHeaderColCount
'Debug.Print "Columns created count is " & intHeaderColCount
ObjXL.Rows((intRowPos - 1) & ":" & (intRowPos - 1)).SELECT ' Selection for Bold header column (can make 2 if needed)
End Function
PS Done some quick research on GoPro.
Thanks in Advance

 

[Rx_]

it is after 10:00 PM here - you have been busy indeed.
Re-edit your code put in the code tags in front and behind
it is the open square bracket CODE close square brackets
then your code
then open square bracket /CODE close square brackets

it will make it very easy to read.

Step 1 - take out or comment out your complex query
Replace it with a extremely simple query
e.g. Select * from Customers

Once that works, comment it out and
just use your Select statement, don't add the order by just yet.

Put a break point on the SET statement.
In break mode, in the immediate window
user debug.print strSQL (what ever the string variable was for the sql statement. Now, take that sql string from the immediate window and past it into a new Query in SQL mode - run it.
It is the old trick to locate your problem.

 

[Antanas_07]

Dear Dx,
I will investigate the code and will follow your advice. Just in case will mention that I did put SQL from SELECT to WHERE in a new query design SQL window (picked up the idea from some lessons on the net. and comments on mistakes ARE meaningful). The aim was to see if the query runs. And it did.
Kind Regards

 

[Rx_]

Set rstDataMonthlyRpt = CurrentDb.OpenRecordset(strSQLMonthlyRpt, dbOpenSnapshot, dbReadOnly + dbSeeChanges) '
If the query has even one character wrong - this line will fail.
Put a break point on this line of code. Execute it up to this point.
Then in the Immeidate window during the code break - Debug.Print strSQLMonthlyRpt
(I realize you have a different string variable for the strSQLMonthlyRpt - so substitute your string.
the return value in the Immeidate Window will be your constructed SQL statement string.
Copy that SQL Statement string - Create a new Query - Set to SQL view - paste the string into the new query window. Does it run OK? That is the real test.

Copy that

 

[Antanas_07]

Hi Rx
I though I am getting somewhere, but now I thing I am not. I did put breaking point and did run a code OnClick copied it to SQL and it came up with Data Type mismatch. Can not see a Different type of variables with strSQLMonthlyRpt. And I fell in to abyss of doubts and questions. Firstly I had to get SQL statement work to imitate query, then it had to be enhanced with conditional bit, where I can borrow from lets say form an input data and after the whole thing exports to Excel. So Now I stuck with SQL statement, and apparently went blind, so I can not see what obvious. I am going to drill the SQL statement.

 

[Antanas_07]

And Yes the Line Failed