3

我一直在尝试使用 Access 2003 将交叉表查询结果集导出到 Excel，但成功有限。有时，导出工作正常，并且 Excel 显示没有错误。其他时候，使用完全相同的查询参数，我得到一个 3190 错误 - 字段太多。我在从 VB 代码调用的宏中使用 TransferSpreadsheet 选项。

该宏具有以下参数： 传输类型：导出电子表格类型：Microsoft Excel 8-10 表名：（这是我的查询名称） 文件名：（Excel 输出文件，存在于目录中） 具有字段名称：是

查询不应产生超过 14 列的信息，因此 Excel 255 列限制应该不是问题。此外，在我查询期间数据库中的数据没有变化，因此相同的查询将产生相同的结果集。

到目前为止，我在网上阅读的唯一解决方案之一是在运行宏之前关闭记录集，但这是命中或未命中。

非常感谢您的想法/帮助！

4

4 回答 4

2

我有一个作为 MS Access 宏工作。它使用 OutputTo Action 与：

  • 对象类型=查询
  • 对象名称=[WhateverQueryName]
  • 输出格式=MicrosoftExcel(*.xls)
  • 自动启动=否
  • （其余全部空白）

我讨厌在 MS Access 中使用宏（感觉不干净），但不妨试一试。

于 2008-12-08T15:25:48.807 回答
1

如果您愿意使用一点 vba 而不是只使用宏，那么以下内容可能会对您有所帮助。这个模块接受你扔给它的任何 sql 并将其导出到 Excel 工作表中的定义位置。在模块之后是它的两个使用示例，一个用于创建一个全新的工作簿，一个用于打开现有的工作簿。如果您对使用 SQL 没有信心，只需创建所需的查询，保存它，然后将“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

希望这对你有一些用处。

于 2009-03-06T13:32:03.390 回答
0

一种解决方法是先将查询附加到表中，然后将其导出。

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

TempTable-Make 是基于交叉表的生成表查询。

这是您可以使用的适当的 ExportToExcel 函数。

于 2008-12-10T15:35:50.797 回答
0

以下代码使用专门设计用于导入记录集的 excel 函数导出查询CopyFromRecordset。请注意，需要添加字段名称，因为此函数仅获取实际数据。此代码甚至适用于交叉表查询。

'---------------------------------------------------------------------------------------
' 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
于 2019-07-18T08:50:23.333 回答