如何从Access将选定的数据导出到Excel？

Question

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

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

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

我要导出所选的数据。 如何将其注入此代码？

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

Answer 1

Excel确实有一种完全不使用VBA的方式从Access导入数据的方法。

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

2. 将查询编辑为所需的内容 。
   通过单击菜单Data > Connections来打开连接窗口，然后选择刚刚创建的连接。 然后，转到下一个选项卡（定义），将“命令类型”从“表”更改为“ SQL”，然后在命令文本中键入命令。
   暂时不要关闭窗口。

3. 在您的日期上添加条件 。
   如果调用了该字段，例如MyDate，则添加一个WHERE子句，如下所示： (MyDate >= ? AND MyDate <= ?) 。
   刷新数据时，系统将提示您提供值来替换2个问号，并且可以选择指定一个单元格来执行此操作。 您还可以选择查询，使其始终使用您定义的内容。

请注意，正确完成操作后，您可以在表中对字段进行重新排序和/或创建公式，而完全不会对Excel造成任何问题。 您还可以使用公式在底部创建一个“总计”行以汇总值（Excel将显示一个下拉列表以创建SUBTOTAL公式，该公式对过滤器很方便。

如果要使用VBA刷新数据，则只需执行一行代码即可： ThisWorkbook.Connections(...).Refresh或ApExcel.Workbooks(..).Connections(...).Refresh 。

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