Exporting a Query to a Spreadsheet

[grovelli]

I use the following syntax to export a crosstab query results into a spreadsheet
DoCmd.TransferSpreadsheet acExport, , "qt", "C:\Test\rtep.xlsx", True
in this case the spreadsheet named rtep.xlsx is created from scratch but how can I export the same to an empty sheet(let's call it 'qt') of an already existing spreadsheet?

[HansV]

If you specify the name of an existing workbook, TransferSpreadsheet will create a sheet in that workbook with the same name as the table or query that you export. If there is already a sheet of that name, it will be overwritten without notice (ALL existing content in that sheet will be lost).

[grovelli]

Thanks again Hans :-)

[grovelli]

I've just noticed that if there's already a sheet of that name, it won't be overwritten but another sheet qt1 is created; is there a way to make it overwrite the existing sheet?

[grovelli]

It's ok, I've found the solution, to achieve that one must specify the Range parameter:
DoCmd.TransferSpreadsheet acExport, , "qt", "C:\produzioni\stat.xlsx", True, "qt"

[grovelli]

Is there a way to empty the qt sheet in Stat.xlsx before importing the output of the qt query into it using the
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qt", "O:\produzioni\stat.xlsx", True, "qt"
line you see below?
I don't see any Sheet.Empty method in VBA.

Private Sub Comando0_Click()
On Error GoTo Err_Comando0_Click
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qt", "O:\produzioni\stat.xlsx", True, "qt"
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open("O:\produzioni\stat.xlsx")
Set xlSheet = xlBook.Sheets("qt")
xlSheet.Columns("A:A").EntireColumn.AutoFit
Set xlSheet = Nothing
Set xlBook = Nothing
Exit_Comando0_Click:
Exit Sub
Err_Comando0_Click:
MsgBox Err.Description
Resume Exit_Comando0_Click
End Sub

[HansV]

There is no Sheet.Empty method. You can use code like this:

Code: Select all

Private Sub Comando0_Click()
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    On Error GoTo Err_Comando0_Click
    ' Start Excel
    Set xlApp = New Excel.Application
    ' Open the workbook
    Set xlBook = xlApp.Workbooks.Open("O:\produzioni\stat.xlsx")
    ' Clear the sheet
    Set xlSheet = xlBook.Sheets("qt")
    xlSheet.Cells.Clear
    ' Save and close the workbook
    xlBook.Close True
    ' Export the data
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
        "qt", "O:\produzioni\stat.xlsx", True, "qt"
    ' Open the workbook again
    Set xlBook = xlApp.Workbooks.Open("O:\produzioni\stat.xlsx")
    ' Autofit column A
    Set xlSheet = xlBook.Sheets("qt")
    xlSheet.Columns("A:A").EntireColumn.AutoFit
    xlApp.Visible = True

Exit_Comando0_Click:
    Exit Sub

Err_Comando0_Click:
    MsgBox Err.Description
    Resume Exit_Comando0_Click
End Sub

[grovelli]

Thank you Hans :-)

[grovelli]

By the way, what is the purpose of the "spoiler" button on the toolbar when you prepare a message? I see it hides the word(s) you write between the spoiler tags.

[HansV]

It's used if you want to post a riddle and hide the answer, or post a joke and hide the clue. So it's mostly used in the Puzzles and Scuttlebutt forums, not so much in the Office or Windows forums.

[grovelli]

I've just installed Office 2013 and the code(taken from above)

Code: Select all

 DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
        "qt", "O:\produzioni\stat.xlsx", True, "qt"

still works fine: data gets exported to the qt sheet in the attached stat - Copia.xlsx file but for some reason now cells C9:C39 in the ProdvsBDG-mese sheet don't seem to recognise the dates as they do when the export is done using Access 2010?

[HansV]

What is the problem?

S0485.png

[grovelli]

Huh?! How did that happen?
How about this one then?

[grovelli]

Or the attached one, in case OneDrive still isn't palatable

[HansV]

Here is a screenshot of the workbook on OneDrive:

S0486.png

[HansV]

There does appear to be a problem with the "stat - Copia (2).xlsx" workbook:

S0487.png

However, if I select F9, press F2 then Enter without changing anything, the value is corrected:

S0488.png

[grovelli]

Thank you Hans, I'd have to repeat, "select F9, press F2 then Enter" for every cell in the D9:S32 range in the ProdvsBDG-mese sheet; any way to automate that? (I suppose such automation code should be put at the bottom of Private Sub Comando0_Click() you see above)

[HansV]

For me, selecting cell C9 (not F9, sorry), and pressing F2 then Enter was sufficient - the cells below recalculated automatically without having to edit them too.

However, you could add the following lines just above xlApp.Visible = True:

Code: Select all

    Set xlSheet = xlBook.Sheets("ProdvsBDG-mese")
    With xlSheet.Range("C9:C39")
        .Formula = .Formula
    End With

[grovelli]

There are also the cells in the D9:S39 range in the ProdvsBDG-mese sheet that need recalculating otherwise the cells remain empty. In any case, running the code below from Access doesn't change anything: cell C9 still displays 00/01/1900 and cells D9:S39 still display empty.

Code: Select all

Private Sub Comando0_Click()
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim strSQL As String
    On Error GoTo Err_Comando0_Click
    ' Start Excel
    Set xlApp = New Excel.Application
    ' Open the workbook
    Set xlBook = xlApp.Workbooks.Open("O:\produzioni\stat.xlsx")
    ' Clear the sheet
    Set xlSheet = xlBook.Sheets("qt")
    xlSheet.Cells.Clear
    ' Save and close the workbook
    xlBook.Close True
    ' Export the data
    If IsNull(Forms!RTEP!Anno) Then
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qt", "O:\produzioni\stat.xlsx", True, "qt"
    Else
        strSQL = CurrentDb.QueryDefs("OreIntUnionxxTemplate").SQL
        strSQL = Replace(strSQL, "@Anno", Me.Anno)
        strSQL = Replace(strSQL, "@Mese", Me.Mese)
        CurrentDb.QueryDefs("OreIntUnionxx").SQL = strSQL
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qtxx", "O:\produzioni\stat.xlsx", True, "qt"
    End If
    'rename the sheet to something more friendly to humans
    'xlBook.Sheets(sheetIn).Name = "New Sheet Name"
    'xlApp.Visible = True
    ' Open the workbook again
    Set xlBook = xlApp.Workbooks.Open("O:\produzioni\stat.xlsx")
    ' Autofit column A
    Set xlSheet = xlBook.Sheets("qt")
    xlSheet.Columns("A:A").EntireColumn.AutoFit
    xlBook.Sheets("ProdvsBDG-mese").Select
    Set xlSheet = xlBook.Sheets("ProdvsBDG-mese")
    With xlSheet.Range("C9:S39")
        .Formula = .Formula
    End With
    xlApp.Visible = True
    'this will give you the last row used on the spreadsheet
    'in case you want to programatically create a total line - there must
    'be something in column A for this to work, of use another column that
    'has data in every row
    'lngLastRow = xlSheet.Range("A65536").End(xlUp).Row
    Set xlSheet = Nothing
    Set xlBook = Nothing
    'xlApp.Quit
    'Set xlApp = Nothing

Exit_Comando0_Click:
    Exit Sub

Err_Comando0_Click:
    MsgBox Err.Description
    Resume Exit_Comando0_Click

End Sub

[HansV]

Could you attach a stripped-down and zipped copy of the database? Or if it's too large, make it available through OneDrive?