将 Access 2003 列表框行源（查询）导出到 Excel 2003 的最有效方法

Posted 2023-05-07

【中文标题】将 Access 2003 列表框行源（查询）导出到 Excel 2003 的最有效方法

【英文标题】：Most Efficient Way To Export Access 2003 Listbox RowSource (query) To Excel 2003

【发布时间】：2013-07-10 15:35:28

【问题描述】：

用户在表单中动态生成查询，结果显示在同一表单的列表框中。列表框可以有 1 到 12 列。

用户希望此查询的结果能够导出到 Excel。我相信不保存文件是首选，但任何工作都可以。

我目前找到了两种方法，每种方法都有自己的问题

1

myExApp.visible = True              
myExApp.Workbooks.Add               

Set myExSheet = myExApp.Workbooks(1).Worksheets(1)
If myExApp.Ready = True Then
For i = 1 To Me!listDynamicSearchResult.ColumnCount   
    Me!listDynamicSearchResult.BoundColumn = 
    Me!listDynamicSearchResult.BoundColumn + 1 
    For j = 1 To Me!listDynamicSearchResult.ListCount 
        myExSheet.Cells(j, i) = Me!listDynamicSearchResult.ItemData(j - 1)
    Next j  
Next i  
Me!listDynamicSearchResult.BoundColumn = 0    
End If

效果很好，但由于显而易见的原因变得指数级缓慢。

当用户在现在打开的 Excel 工作表中单击时，该方法也会导致错误。

再加上它有多慢，用户很可能会导致错误，试图在循环完成之前操作表单。

2

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "test", "I:\test.xls"

该方法涉及将动态生成的查询保存到单击时保存的查询中。

这样做的问题是列没有被格式化，并且 excel 将所有内容读取为字符串而不是数据类型，而在第一种方法中，数据类型被正确读取。

有什么方法可以缓解这些问题，或者有更有效的方法吗？

解决方案（目前格式化为字符串）

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets(1)

xlApp.visible = True
strFile = CurrentProject.FullName
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"

Set cn = CurrentProject.AccessConnection
Set rs = CreateObject("ADODB.recordset")
With rs
    Set .ActiveConnection = cn
    .Source = Me!listDynamicSearchResult.RowSource
    .Open
End With

With xlWs
  .QueryTables.Add Connection:=rs, Destination:=.Range("A1")
  .QueryTables(1).Refresh
End With

【参考方案1】：

您可以在 Excel 中使用与 Listbox 的 RowSource 相同的外部数据源创建 ListObject。

Private Sub Command2_Click()

    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook
    Dim xlWs As Excel.Worksheet
    Dim xlLo As Excel.ListObject

    Set xlApp = GetObject(, "Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets(1)

    Set xlLo = xlWs.ListObjects.Add(xlSrcExternal, "OLEDB;" & CurrentProject.Connection, , xlYes, xlWs.Range("A3"))
    xlLo.QueryTable.CommandType = xlCmdSql
    xlLo.QueryTable.CommandText = Me.listDynamicSearchResult.RowSource

    DoCmd.Close acForm, Me.Name

End Sub

在我关闭 Access 中的表单之前，我无法刷新 Excel 中的列表。所以你可能需要处理一些权限问题。

【讨论】：

也许对元素的引用是问题所在。也许在发送查询之前将查询移动到变量可能会有所帮助？

手动执行时遇到相同的权限问题。如果我打开了 Access 并打开了 Excel（带有查询表），它会警告我我需要独占访问权限。由于 Excel 端是只读的，这应该不是问题。但我很确定是连接字符串决定了它。如果你得到正确的连接字符串，我敢打赌你可以摆脱这个问题。 （然后告诉我你做了什么）。 :)

我安装了 Microsoft Excel 11.0 对象库，但出现错误“错误 429 ActiveX 组件无法创建对象”。我需要另一个\不同的库吗？

如果 Excel 未打开，您可以将其更改为 CreatObject。或者，如果您是早期绑定，则可以使用 Set xlApp = New Excel.Application。我使用 GetObject b/c 我已经打开它并且不想要单独的实例。

抱歉所有问题！应用程序之间的通信我没有做太多，所以我比较盲目。我在“Set xlLo = xlWs.ListObjects.Add(blah)”部分出现错误。错误 5 过程调用或参数无效。我不确定是什么原因造成的:(

【参考方案2】：

尝试生成一个 XML 文件。这里是一个例子：http://blogs.msdn.com/b/brian_jones/archive/2005/06/27/433152.aspx

附：关于第一种方法。 为避免用户点击，您可以隐藏 Excel。 您还可以加速 Excel（参见下面的函数）。在放置数据之前使用 Prepare() 并在其后使用 Ended() 或以防出错。

Public Sub Prepare()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
End Sub

Public Sub Ended()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
End Sub

【讨论】：

我没有意识到您可以更改 Excel 中的 screenUpdating 属性。否则我会尝试的！我在 activeSheet.DisplayPageBreaks = false\true 部分收到一个错误，但总的来说它加速了事情。我将把你的两个建议结合起来玩，看看它对我有什么好处。

编辑这有助于加快迪克库斯莱卡的回答。谢谢！

【参考方案3】：

请参阅本网站以了解所有可能的方法以及它们的优点/缺点。 对于您的问题，我更喜欢使用 DAO 方法。示例代码也在这个网站上。

Way to transer data from access to excel

当您逐个单元格导入时，您可以根据需要格式化任何行、列、单元格。例如：

 xlActiveSheet.Cells(4,5).Characters(2).Font.ColorIndex = 5

或

xlActiveSheet.Columns("A:AZ").EntireColumn.AutoFit

或

xlActiveSheet.Range(xlActiveSheet.Cells(1, 1), xlActiveSheet.Cells(1, rec1.Fields.count)).Interior.ColorIndex = 15

【讨论】：

我非常喜欢 xlActiveSheet.Columns("A:AZ").EntireColumn.AutoFit ，绝对可以很好地清理表单。这也避免了像 Sergey 的回答那样花哨地解析 XML。