简体   繁体   中英

How can I export selected data to Excel from Access?

I am using the code from Function to export query or table to MS Excel to export all the data from one Access table to a worksheet in MS Excel.

This program stores time in and time out of employees in the table.

Let's say the admin wants to filter the data from 01 Jan 19 to 15 Jan 19. I want to put two datepickers on my form as a basis for the "From" and "To".

I want to export that selected data. How can I inject that to this code?

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

Excel does have a way to import data from Access with no VBA at all.

  1. Create the connection to fill your worksheet . Go to Menu Data > Access. You will be asked to pick an Access database and select the table you want. You probably want a query to be executed but for now, pick any table; this will be edited later.

  2. Edit the query to what you want .
    Open the connection window by clicking on the menu Data > Connections and pick the connection you have just created. Then, go to the next tab (Definition), change Command Type from Table to SQL then in command text, type your command.
    Don't close the window just yet.

  3. Add condition on your date .
    If the field is called, for instance, MyDate, then add a WHERE clause like this one: (MyDate >= ? AND MyDate <= ?) .
    When you refresh the data, you will be prompted to give values to replace the 2 question marks, and you will have the option to designate a cell to do it. You will also have an option for the query to always use what you have defined.

Note that when done correctly, you can reorder fields and/or create formulae in the table without causing any sort of problem to Excel at all. You can also create a Total row at the bottom to sum up values, using a formula (Excel will show you a dropdown to create a SUBTOTAL formula, that is conveniently sensitive to filters.

If you want to refresh data with VBA, it takes a single line of code to do: ThisWorkbook.Connections(...).Refresh or ApExcel.Workbooks(..).Connections(...).Refresh .

PS: If you absolutely want to keep your code above, then at least make sure not to copy rs2 cell by cell (that is way to slow due to Excel event handling) but rather, do something like: ApExcel.Cells(2, 1).CopyFromRecordset rs2

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM