从MS Access中导出交叉表查询结果到Excel
我一直在试图用有限的成功将交叉表查询结果集导出到使用Access 2003的Excel中。偶尔，导出工作正常，并且Excel显示没有错误。 其他时候，使用完全相同的查询参数，我得到一个3190错误 – 太多的领域。 我从VB代码调用的macros中使用TransferSpreadsheet选项。
该macros具有以下参数：传输types：导出电子表格types：Microsoft Excel 8-10表名称:(这是我的查询名称）文件名称：（存在于目录中的Excel输出文件）具有字段名称：是
查询不应该产生超过14列的信息，所以Excel 255的上限不应该是一个问题。 另外，数据库中的数据在我查询的时间内没有变化，所以相同的查询会产生相同的结果集。
到目前为止，我在网上读到的唯一解决scheme之一是在运行macros之前closureslogging集，但这是碰巧或错过的。
你的想法/帮助非常感谢！
我有一个作为一个MS Accessmacros的工作。 它使用OutputTo操作：
- 对象types=查询
- 对象名称= [WhateverQueryName]
- 输出格式= MicrosoftExcel（* .xls）
- 自动启动=否
- （所有其余的空白）
我讨厌在MS Access中使用macros（它感觉不干净），但也许给一个尝试。
如果你愿意使用一点vba而不是专门用macros，下面的内容可能会帮助你。 这个模块接受你抛出的任何sql，并把它导出到excel工作表中定义的位置。 在模块是两个使用的例子之后，一个创build一个全新的工作簿，一个打开现有的工作簿。 如果您对使用SQL没有信心，只需创build您想要的查询，保存它，然后将“SELECT * FROM [YourQueryName]”作为QueryString参数提供给Sub。
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 例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
例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
希望这对你有一些用处。
解决方法是将查询追加到表中，然后导出。
DoCmd.SetWarnings False DoCmd.OpenQuery "TempTable-Make" DoCmd.RunSQL "DROP TABLE TempTable" ExportToExcel() DoCmd.SetWarnings True
TempTable-Make是一个基于交叉表的生成表查询。
这里有一个可以使用的适当的ExportToExcel函数。