Copy data from an Access database into Excel with ADO

Important message to visitors of this page

Ron de Bruin decided to remove all Windows Excel content from his website for personal reasons. If you want to know why, head over to rondebruin.nl.

Luckily, Ron was kind enough to allow me to publish all of his Excel content here.

Most of these pages are slightly outdated and may contain links that don 't work. Please inform me if you find such an error and I'll try to fix it.

Kind regards

Jan Karel Pieterse

Most examples on the internet are not so easy to work with for a normal user like me. I have try to change that on this webpage. We use small macro's that are not so difficult to use/change that call one big macro named GetDataFromAccess. The examples are created in 2006 but still working in Excel 2013.

You can download a zip file on the bottom of this page with two Excel workbooks and the OrderDatabase.mdb to test the examples.

In one workbook you can find all code from this page and in the other one it is very easy get the info you want because you can save the criteria (100 or more) and can use Data>Validation cells to select your criteria. Note: the workbooks and the OrderDatabase.mdb must be in the same folder

In the OrderDatabase.mdb there is a table named Orders with the following fields:

OrderNumber
OrderDate
RequiredDate
ShippedDate
Freight
ShipVia
ShipCountry
ShipName
ShipAddress
ShipCity
ShipRegion
ShipPostalCode

Below you find a few example macro's that you can use to retrieve only the records you want

First line: Path/name of the Access file, Table name
Second-Eighth line: You can fill in seven criteria, and if you not fill in any criteria it return all records
The first three criteria are only for Text fields
The fourth and fifth are for numbers fields
The sixth and seventh are for date fields
Line nine: Destination sheet/range
Line ten: Which fields ( * = all), Copy field names, clear all cells on Destination sheet first

Note: If you use criteria 4-7 (number or Date fields) you can change >, <, >=, <= to get the result you want.

Sub Test1()
'This example retrieves the data for the records in which ShipCountry = Germany
    GetDataFromAccess ThisWorkbook.Path & "/OrderDatabase.mdb", "Orders", _
                      "ShipCountry", "=", "Germany", _
                      "", "=", "", _
                      "", "=", "", _
                      "", ">", "", _
                      "", "<", "", _
                      "", ">=", "", _
                      "", "<=", "", _
                      Sheets("test").Range("A8"), _
                      "*", True, True
End Sub


Sub Test2()
'This example retrieves also the data for the records in which ShipCountry = Germany
'It only retrieves this four fields: OrderNumber, ShipName, ShipAddress, ShipPostalCode
'I changed the "*" for WhichFields in the code to the names of the fields
    GetDataFromAccess ThisWorkbook.Path & "/OrderDatabase.mdb", "Orders", _
                      "ShipCountry", "=", "Germany", _
                      "", "=", "", _
                      "", "=", "", _
                      "", ">", "", _
                      "", "<", "", _
                      "", ">=", "", _
                      "", "<=", "", _
                      Sheets("test").Range("A8"), _
                      "OrderNumber, ShipName, ShipAddress, ShipPostalCode", True, True
End Sub


Sub Test3()
'This example retrieves the data for the records in which
'ShipCountry = Germany and ShipVia = Speedy Express
    GetDataFromAccess ThisWorkbook.Path & "/OrderDatabase.mdb", "Orders", _
                      "ShipCountry", "=", "Germany", _
                      "ShipVia", "=", "Speedy Express", _
                      "", "=", "", _
                      "", ">", "", _
                      "", "<", "", _
                      "", ">=", "", _
                      "", "<=", "", _
                      Sheets("test").Range("A8"), _
                      "*", True, True
End Sub


Sub Test4()
'This example retrieves the data for the records in which
'ShipCountry = Germany and ShipVia = Speedy Express
'and Freight = between 100 and 300
    GetDataFromAccess ThisWorkbook.Path & "/OrderDatabase.mdb", "Orders", _
                      "ShipCountry", "=", "Germany", _
                      "ShipVia", "=", "Speedy Express", _
                      "", "=", "", _
                      "Freight", ">", "100", _
                      "Freight", "<", "300", _
                      "", ">=", "", _
                      "", "<=", "", _
                      Sheets("test").Range("A8"), _
                      "*", True, True
End Sub


Sub Test5()
'This example retrieves the data for the records in which
'ShipCountry = Germany and ShipVia = Speedy Express
'and ShippedDate = between 1/1/1998 and 3/1/1998
    GetDataFromAccess ThisWorkbook.Path & "/OrderDatabase.mdb", "Orders", _
                      "ShipCountry", "=", "Germany", _
                      "ShipVia", "=", "Speedy Express", _
                      "", "=", "", _
                      "", ">", "", _
                      "", "<", "", _
                      "ShippedDate", ">=", "1/1/1998", _
                      "ShippedDate", "<=", "3/1/1998", _
                      Sheets("test").Range("A8"), _
                      "*", True, True
End Sub


Sub Test6()
'This example retrieves all records
    GetDataFromAccess ThisWorkbook.Path & "/OrderDatabase.mdb", "Orders", _
                      "", "=", "", _
                      "", "=", "", _
                      "", "=", "", _
                      "", ">", "", _
                      "", "<", "", _
                      "", ">=", "", _
                      "", "<=", "", _
                      Sheets("test").Range("A8"), _
                      "*", True, True
End Sub

And this is the big macro that you not have to change

Public Sub GetDataFromAccess(MyDatabaseFilePathAndName As String, MyTable As String, _
                    MyTableField1 As String, S1 As String, MyFieldValue1 As String, _
                    MyTableField2 As String, S2 As String, MyFieldValue2 As String, _
                    MyTableField3 As String, S3 As String, MyFieldValue3 As String, _
                    MyTableField4 As String, S4 As String, MyFieldValue4 As String, _
                    MyTableField5 As String, S5 As String, MyFieldValue5 As String, _
                    MyTableField6 As String, S6 As String, MyFieldValue6 As String, _
                    MyTableField7 As String, S7 As String, MyFieldValue7 As String, _
                    DestSheetRange As Range, WhichFields As String, _
                    FieldNames As Boolean, ClearRange As Boolean)

'Date changed : 18 Feb 2006
'Add the WhichFields option to copy only the fields you want

    Dim MyConnection As String
    Dim MySQL As String
    Dim MyDatabase As Object
    Dim col As Integer
    Dim I As Integer
    Dim str1 As Variant
    Dim str2 As Variant
    Dim str3 As Variant

    'Select the DestSheetRange where you paste the records
    Application.GoTo DestSheetRange

    'If ClearRange = True it clear all cells on that sheet first
    If ClearRange Then Range(DestSheetRange.Address, "IV" & Rows.Count).ClearContents

    'Create connection string
    MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
    MyConnection = MyConnection & "Data Source=" & MyDatabaseFilePathAndName & ";"

    ' Create MySQL string
    str1 = Array(MyTableField1, MyTableField2, MyTableField3, MyTableField4, _
             MyTableField5, MyTableField6, MyTableField7)
    str2 = Array(S1, S2, S3, S4, S5, S6, S7)
    str3 = Array(MyFieldValue1, MyFieldValue2, MyFieldValue3, MyFieldValue4, _
            MyFieldValue5, MyFieldValue6, MyFieldValue7)


    MySQL = ""
    For I = LBound(str1) To UBound(str1)
        If str3(I) <> "" Then
            If MySQL = "" Then
                If I <= 2 Then
                    MySQL = "SELECT " & WhichFields & " FROM " & MyTable & " WHERE [" _
                            & str1(I) & "] " & str2(I) & " '" & str3(I) & "'"
                ElseIf I = 3 Or I = 4 Then
                    MySQL = "SELECT " & WhichFields & " FROM " & MyTable & " WHERE [" _
                            & str1(I) & "] " & str2(I) & " " & str3(I)

                ElseIf I = 5 Or I = 6 Then
                    MySQL = "SELECT " & WhichFields & " FROM " & MyTable & " WHERE [" _
                            & str1(I) & "] " & str2(I) & " #" & str3(I) & "#"
                End If

            Else
                If I <= 2 Then
                    MySQL = MySQL & " and [" & str1(I) & "] " & str2(I) & " '" & str3(I) & "'"
                ElseIf I = 3 Or I = 4 Then
                    MySQL = MySQL & " and [" & str1(I) & "] " & str2(I) & " " & str3(I)
                ElseIf I = 5 Or I = 6 Then
                    MySQL = MySQL & " and [" & str1(I) & "] " & str2(I) & " #" & str3(I) & "#"
                End If
            End If
        End If
    Next I

    'If MySQL is empty copy all records
    If MySQL = "" Then MySQL = "SELECT " & WhichFields & " FROM " & MyTable & ";"


    ' Open the database and copy the data
    On Error GoTo SomethingWrong
    Set MyDatabase = CreateObject("adodb.recordset")
    MyDatabase.Open MySQL, MyConnection, 0, 1, 1

    ' Check to make sure we received data and copy the data
    If Not MyDatabase.EOF Then

        'If FieldNames = True copy the field names and records
        'If = False copy only records
        If FieldNames Then
            For col = 0 To MyDatabase.Fields.Count - 1
                DestSheetRange.Offset(0, col).Value = MyDatabase.Fields(col).Name
            Next
            DestSheetRange.Offset(1, 0).CopyFromRecordset MyDatabase
        Else
            DestSheetRange.CopyFromRecordset MyDatabase
        End If
    Else
        MsgBox "No records returned from : " & MyDatabaseFilePathAndName, vbCritical
    End If

    MyDatabase.Close
    Set MyDatabase = Nothing
    Exit Sub

SomethingWrong:
    On Error GoTo 0
    Set MyDatabase = Nothing
    MsgBox "Error copying data", vbCritical, "Test Access data to Excel"

End Sub

Tips

Instead of enter field values in the code you can also use a cell value
"ShipVia", "=", Sheets("Sheet1").Range("A2").Value

Check out "Example to save criteria.xls" where I use data validation cells with unique values from the fields
and you can also save your criteria (100 or more).

See also this page from Ole P. Erlandsen's
http://www.erlandsendata.no/english/index.php?t=envbadac

Download the Example workbooks and database

Download the example files

Ron de BruinExcel Automation