简体   繁体   中英

How to open an access workbook and transfer a table into an excel worksheet using the VBA macro ran on Excel?

I had read that exporting an Excel worksheet from Access will use the DoCmd object and the TransferSpreadsheet method, however, I need a macro that will run from my Excel VBA script.

So the steps would be as following:

  1. Run macro in Excel
  2. Convert access table into an Excel worksheet
  3. Excel VBA code runs a script on the newly converted worksheet.

Or if there was a way to

  1. Run macro in Excel
  2. Perform script on access table, the better.

Well, your questions doesn't totally make sense, but I'm guessing that you want to import data from Access into Excel. Is that right?

Import data from Access to Excel (DAO)

CopyFromRecordset is probably the easiest method of getting data from an Access table to an Excel worksheet.

Sub DAOCopyFromRecordSet(DBFullName As String, TableName As String, _
    FieldName As String, TargetRange As Range)
' Example: DAOCopyFromRecordSet "C:\FolderName\DataBaseName.mdb", _
    "TableName", "FieldName", Range("C1")
Dim db As Database, rs As Recordset
Dim intColIndex As Integer
    Set TargetRange = TargetRange.Cells(1, 1)
    Set db = OpenDatabase(DBFullName)
    Set rs = db.OpenRecordset(TableName, dbOpenTable) ' all records
    'Set rs = db.OpenRecordset("SELECT * FROM " & TableName & _
        " WHERE " & FieldName & _
        " = 'MyCriteria'", dbReadOnly) ' filter records
    ' write field names
    For intColIndex = 0 To rs.Fields.Count - 1
        TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
    Next
    ' write recordset
    TargetRange.Offset(1, 0).CopyFromRecordset rs
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

If you want more control with the data import, you can customize the macro below:

Sub DAOFromAccessToExcel(DBFullName As String, TableName As String, _
    FieldName As String, TargetRange As Range)
' Example: DAOFromAccessToExcel "C:\FolderName\DataBaseName.mdb", _
    "TableName", "FieldName", Range("B1")
Dim db As Database, rs As Recordset
Dim lngRowIndex As Long
    Set TargetRange = TargetRange.Cells(1, 1)
    Set db = OpenDatabase(DBFullName)
    Set rs = db.OpenRecordset(TableName, dbOpenTable) ' all records
    'Set rs = DB.OpenRecordset("SELECT * FROM " & _
        TableName & " WHERE " & FieldName & _
        " = 'MyCriteria'", dbReadOnly) ' filter records
    lngRowIndex = 0
    With rs
        If Not .BOF Then .MoveFirst
        While Not .EOF
            TargetRange.Offset(lngRowIndex, 0).Formula = .Fields(FieldName)
            .MoveNext
            lngRowIndex = lngRowIndex + 1
        Wend
    End With
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

Or...

  Import data from Access to Excel (ADO)

With the procedure below you can import data from an Access table to a worksheet.

Sub ADOImportFromAccessTable(DBFullName As String, _
    TableName As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
    "TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
    Set TargetRange = TargetRange.Cells(1, 1)
    ' open the database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
        DBFullName & ";"
    Set rs = New ADODB.Recordset
    With rs
        ' open the recordset
        .Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable 
        ' all records
        '.Open "SELECT * FROM " & TableName & _
            " WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText 
        ' filter records

        RS2WS rs, TargetRange ' write data from the recordset to the worksheet

'        ' optional approach for Excel 2000 or later (RS2WS is not necessary)
'        For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
'            TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
'        Next
'        TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data

    End With
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

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