如何從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