CODEWITHSUNDEEP
excelms-accessexport
Tim
Tim

Reputation:

Exporting crosstab query results to Excel from within MS Access

I've been trying with limited success to export a crosstab query result set to Excel using Access 2003. Occasionally, the export works correctly, and Excel shows with no errors. Other times, using the exact same query parameters, I get a 3190 error - too many fields. I am using the TransferSpreadsheet option in a macro that is called from VB code.

The macro has the following parameters: Transfer type: Export Spreadsheet type: Microsoft Excel 8-10 Table Name: (this is my query name) File Name: (Excel output file, which exists in the directory) Has Field Names: Yes

The query should not produce any more than 14 columns worth of information, so the Excel 255 col limit should not be a problem. Also,the data in the database is not changing during the time I am querying, so the same query will produce the same result set.

One of the only solutions I have read on the net thus far is to close the recordset before running the macro, but this is hit or miss.

Your thoughts/help are greatly appreciated!

Upvotes: 3

Views: 11962

Answers (4)

rohrl77
rohrl77

Reputation: 3337

The following code exports queries using the function in excel that was specifically designed to import recordsets CopyFromRecordset. Note that field names need to be added as this function only grabs the actual data. This code works even on crosstab queries.

'---------------------------------------------------------------------------------------
' Method : MoveQueryToWorksheet
' Author : ROLU
' Date   : 09.05.2018
' Purpose: Moves queries to specific worksheet in an Excel Workbook
'---------------------------------------------------------------------------------------
Function MoveQueryToWorksheet(wkb As Excel.Workbook, wks As Variant, strSQL As Variant) As Boolean
On Error GoTo MoveQueryToWorksheet_Error

'Dim rs As New ADODB.Recordset
'rs.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly

Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim rs
Set rs = dbs.OpenRecordset(strSQL)

Dim lCol As Long
For lCol = 0 To rs.Fields.Count - 1
    wkb.Worksheets(wks).Cells(1, lCol + 1).Value = rs.Fields(lCol).Name
Next lCol
wkb.Worksheets(wks).Range("A2").CopyFromRecordset rs

'Close out and clean
Set rs = Nothing
MoveQueryToWorksheet = True

    Exit Function

MoveQueryToWorksheet_Error:
On Error GoTo 0
Set rs = Nothing
MoveQueryToWorksheet = False

End Function

Upvotes: 0

mavnn
mavnn

Reputation: 9469

If you're willing to make use of a little vba rather than stick exclusively with macros, the following might help you. This module takes any sql you throw at it and exports it to a defined location in an excel worksheet. After the module are two examples of it's use, one to create a completely new workbook, one which opens an existing one. If you not confident with using SQL just create the query you want, save it and then supply "SELECT * FROM [YourQueryName]" to the Sub as the QueryString parameter.

Sub OutputQuery(ws As excel.Worksheet, CellRef As String, QueryString As String, Optional Transpose As Boolean = False)

    Dim q As New ADODB.Recordset
    Dim i, j As Integer

    i = 1

    q.Open QueryString, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly


    If Transpose Then
        For j = 0 To q.Fields.Count - 1
            ws.Range(CellRef).Offset(j, 0).Value = q(j).Name
            If InStr(1, q(j).Name, "Date") > 0 Or InStr(1, q(j).Name, "DOB") > 0 Then
                ws.Range(CellRef).Offset(j, 0).EntireRow.NumberFormat = "dd/mm/yyyy"
            End If
        Next

        Do Until q.EOF
            For j = 0 To q.Fields.Count - 1
                ws.Range(CellRef).Offset(j, i).Value = q(j)
            Next
            i = i + 1
            q.MoveNext
        Loop
    Else
        For j = 0 To q.Fields.Count - 1
            ws.Range(CellRef).Offset(0, j).Value = q(j).Name
            If InStr(1, q(j).Name, "Date") > 0 Or InStr(1, q(j).Name, "DOB") > 0 Then
                ws.Range(CellRef).Offset(0, j).EntireColumn.NumberFormat = "dd/mm/yyyy"
            End If
        Next

        Do Until q.EOF
            For j = 0 To q.Fields.Count - 1
                ws.Range(CellRef).Offset(i, j).Value = q(j)
            Next
            i = i + 1
            q.MoveNext
        Loop
    End If

    q.Close

End Sub

Example 1:

Sub Example1()
    Dim ex As excel.Application
    Dim wb As excel.Workbook
    Dim ws As excel.Worksheet

    'Create workbook
    Set ex = CreateObject("Excel.Application")
    ex.Visible = True
    Set wb = ex.Workbooks.Add
    Set ws = wb.Sheets(1)

    OutputQuery ws, "A1", "Select * From [TestQuery]"
End Sub

Example 2:

Sub Example2()
    Dim ex As excel.Application
    Dim wb As excel.Workbook
    Dim ws As excel.Worksheet

    'Create workbook
    Set ex = CreateObject("Excel.Application")
    ex.Visible = True
    Set wb = ex.Workbooks.Open("H:\Book1.xls")
    Set ws = wb.Sheets("DataSheet")

    OutputQuery ws, "E11", "Select * From [TestQuery]"
End Sub

Hope that's of some use to you.

Upvotes: 1

Jon Wilson
Jon Wilson

Reputation: 776

A workaround would be to append the query to a table first and then export that. 

DoCmd.SetWarnings False
 DoCmd.OpenQuery "TempTable-Make" 
 DoCmd.RunSQL "DROP TABLE TempTable" 
 ExportToExcel()
DoCmd.SetWarnings True

TempTable-Make is a make-table query based on the crosstab.

Here is an appropriate ExportToExcel function you can use.

Upvotes: 0

BIBD
BIBD

Reputation: 15404

I've got one working as an MS Access Macro. It uses an OutputTo Action with:

  • Object Type=Query
  • Object Name=[WhateverQueryName]
  • Output Format=MicrosoftExcel(*.xls)
  • Auto Start=No
  • (all the rest blank)

I hate using Macros in MS Access (it feels unclean), but perhaps give that a try.

Upvotes: 2

Related Questions