Paste Faster into Excel

Excel and Access often do come along. When you have make them work combining one database with dozens of Excel sheets it is necessary to be able to read and write data fast, otherwise it becomes annoying pretty fast. There are several ways to apporach this problem. Reading Excel sheet into Access can be easily done with

   DoCmd.TransferSpreadsheet

widely described on the MSDN. But how to write data back from Access into Excel spreadsheet?

Frist you need to connect to the database. There are three main ochoices Data Access Objects (DAO), Remote Data Objects (RDO), and ActiveX Data Objects (ADO) regarding the data connection. I have listed them in chronological order, for more details see Microsoft’s comparison of the technologies. But let me cite one important sentence

In general, it’s probably too early in the evolution of ADO to migrate most DAO applications (except possibly ones using ODBCDirect) to ADO right now, since ADO doesn’t currently support data definition (DDL), users, groups, and so forth.

For getting data from Access into Excel it really does not matter which of the above will you use. I use DAO. The code below shuld be used in Access. It will open the connection to the local database, open an Excel workbook, and rewrite the data from a certain table to one of the workbook’s sheets.

First create a function which will rewrite fetched record of data into an array.

Private Function as_array(ByRef rs AS DAO.RecordSet) As Variant()

   Dim my_array() AS Variant

   ReDim my_array(1 To UBound(rs)) AS Variant
   For i = 1 To UBound(rs)
       my_array(i) = rs(i).Value
   Next i

   ' Return
   as_array = my_array()

End Function

Now, a subroutine

Sub rewrite_data()

    Dim db AS DAO.Database
    Dim rs AS DAO.RecordSet
    Dim sql AS String
    Set db = Currentdb
    '
    ' Open Excel spreadsheet

    ' Get the data
    sql = "SELECT * FROM my_table;"
    Set rs = db.OpenRecordset(sql, dbOpenForwardOnly, dbReadOnly)
    If NOT rs.EOF Then
       Dim my_array AS Variant()
       my_array = as_array(rs)
    End If
    '
    ' Close the connection
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing

End Sub

Leave a Reply