首页 > 解决方案 > 如何将所选数据从 Access 导出到 Excel?

问题描述

我正在使用函数中的代码将查询或表导出到 MS Excel,以将所有数据从一个 Access 表导出到 MS Excel 中的工作表。

该程序将员工的进出时间存储在表中。

假设管理员想要过滤从 19 年 1 月 1 日到 19 年 1 月 15 日的数据。我想在我的表单上放置两个日期选择器作为“发件人”和“收件人”的基础。

我想导出选定的数据。如何将其注入此代码?

Public Function Export2XL(InitRow As Long, DBAccess As String, DBTable As String) As Long

Dim cn As New ADODB.Connection        'Use for the connection string
Dim cmd As New ADODB.Command          'Use for the command for the DB
Dim rs2 As New ADODB.Recordset        'Recordset return from the DB
Dim MyIndex As Integer                'Used for Index
Dim MyRecordCount As Long             'Store the number of record on the table
Dim MyFieldCount As Integer           'Store the number of fields or column
Dim ApExcel As Object                 'To open Excel
Dim MyCol As String
Dim Response As Integer

Set ApExcel = CreateObject("Excel.application")  'Creates an object

ApExcel.Visible = True                           'This enable you to see the process in Excel
pExcel.Workbooks.Add                             'Adds a new book.
ApExcel.ActiveSheet.Name = "" & (Export_data.Label1.Caption) & ""

'Set the connection string
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & 
app.Path & "\Dbase.mdb; User ID=admin;Persist Security Info=False;JET 
OLEDB:Database Password=akgtrxx21"
'Open the connection
cn.Open

'Check that the connection is open
If cn.State = 0 Then cn.Open
Set cmd.ActiveConnection = cn
cmd.CommandText = DBTable
cmd.CommandType = adCmdTable
Set rs2 = cmd.Execute
'Count the number of fields or column
MyFieldCount = rs2.Fields.count

'Fill the first line with the name of the fields
For MyIndex = 0 To MyFieldCount - 1
    ApExcel.Cells(InitRow, (MyIndex + 1)).Formula = rs2.Fields(MyIndex).Name   
    'Write Title to a Cell
    ApExcel.Cells(InitRow, (MyIndex + 1)).Font.Bold = True
    ApExcel.Cells(InitRow, (MyIndex + 1)).Interior.ColorIndex = 36
    ApExcel.Cells(InitRow, (MyIndex + 1)).WrapText = True
Next

'Draw border on the title line
MyCol = Chr((64 + MyIndex)) & InitRow
ApExcel.Range("A" & InitRow & ":" & MyCol).Borders.Color = RGB(0, 0, 0)
MyRecordCount = 1 + InitRow

'Fill the excel book with the values from the database
Do While rs2.EOF = False
    For MyIndex = 1 To MyFieldCount
        ApExcel.Cells(MyRecordCount, MyIndex).Formula = rs2((MyIndex - 1)).Value     
        'Write Value to a Cell
        ApExcel.Cells(MyRecordCount, MyIndex).WrapText = False 'Format the Cell
    Next
    MyRecordCount = MyRecordCount + 1
    rs2.MoveNext
    If MyRecordCount > 50 Then
        Exit Do
    End If
Loop

'Close the connection with the DB
rs2.Close

'Return the last position in the workbook
Export2XL = MyRecordCount
Set cn = Nothing
Set cmd = Nothing
Set rs2 = Nothing

Set ApExcel = Nothing

End Function

标签: excelvba

解决方案


Excel 确实有一种方法可以从完全没有 VBA 的 Access 中导入数据。

  1. 创建连接以填写您的工作表。转到菜单数据 > 访问。系统将要求您选择一个 Access 数据库并选择所需的表。您可能希望执行查询,但现在,选择任何表;这将在稍后进行编辑。

  2. 将查询编辑为您想要的
    通过单击菜单Data>打开连接窗口,然后Connections选择您刚刚创建的连接。然后,转到下一个选项卡(定义),将命令类型从表更改为 SQL,然后在命令文本中输入您的命令。
    暂时不要关闭窗口。

  3. 在您的日期添加条件
    如果该字段被调用,例如 MyDate,则添加一个WHERE像这样的子句:(MyDate >= ? AND MyDate <= ?)
    刷新数据时,系统会提示您输入值以替换 2 个问号,并且您可以选择指定一个单元格来执行此操作。您还可以选择让查询始终使用您定义的内容。

请注意,如果操作正确,您可以在表格中重新排序字段和/或创建公式,而不会对 Excel 造成任何问题。您还可以使用公式在底部创建一个总计行来汇总值(Excel 将向您显示一个下拉菜单以创建一个SUBTOTAL公式,该公式对过滤器很方便。

如果你想用 VBA 刷新数据,只需要一行代码:ThisWorkbook.Connections(...).RefreshApExcel.Workbooks(..).Connections(...).Refresh.

PS:如果您绝对希望将代码保留在上面,那么至少确保不要逐个单元格复制 rs2 (由于 Excel 事件处理,这会变慢),而是执行以下操作:ApExcel.Cells(2, 1).CopyFromRecordset rs2


推荐阅读