ERLANDSEN DATA CONSULTING Excel & VBA Tips   Informasjon på norsk / Information in Norwegian

These pages are no longer updated and are only available for archive purposes.

Click here to visit the pages with updated information.

Use a closed workbook as a database (DAO)

With the procedures below you can use DAO to retrieve a recordset from a closed workbook and read/write data. Call the procedure like this:
GetWorksheetData "C:\Foldername\Filename.xls", "SELECT * FROM [SheetName$]", ThisWorkbook.Worksheets(1).Range("A3")
Replace SheetName with the worksheet name you want to retrieve data from.

Sub GetWorksheetData(strSourceFile As String, strSQL As String, TargetCell As Range)
Dim db As DAO.Database, rs As DAO.Recordset, f As Integer, r As Long
    If TargetCell Is Nothing Then Exit Sub
    
    On Error Resume Next
    Set db = OpenDatabase(strSourceFile, False, True, "Excel 8.0;HDR=Yes;") 
    ' read only
    'Set db = OpenDatabase(strSourceFile, False, False, "Excel 8.0;HDR=Yes;") 
    ' write
    'Set db = OpenDatabase("C:\Foldername\Filename.xls", False, True, _
        "Excel 8.0;HDR=Yes;") ' read only
    'Set db = OpenDatabase("C:\Foldername\Filename.xls", False, False, _
        "Excel 8.0;HDR=Yes;") ' write
    On Error GoTo 0
    If db Is Nothing Then
        MsgBox "Can't find the file!", vbExclamation, ThisWorkbook.Name
        Exit Sub
    End If
    
'    ' list worksheet names
'    For f = 0 To db.TableDefs.Count - 1
'       Debug.Print db.TableDefs(f).Name
'    Next f
    
    ' open a recordset
    On Error Resume Next
    Set rs = db.OpenRecordset(strSQL)
'    Set rs = db.OpenRecordset("SELECT * FROM [SheetName$]")
'    Set rs = db.OpenRecordset("SELECT * FROM [SheetName$] " & _
        "WHERE [Field Name] LIKE 'A*'")
'    Set rs = db.OpenRecordset("SELECT * FROM [SheetName$] " & _
        "WHERE [Field Name] LIKE 'A*' ORDER BY [Field Name]")
    On Error GoTo 0
    If rs Is Nothing Then
        MsgBox "Can't open the file!", vbExclamation, ThisWorkbook.Name
        db.Close
        Set db = Nothing
        Exit Sub
    End If
    
    RS2WS rs, TargetCell
    
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

Sub RS2WS(rs As DAO.Recordset, TargetCell As Range)
Dim f As Integer, r As Long, c As Long
    If rs Is Nothing Then Exit Sub
    If TargetCell Is Nothing Then Exit Sub
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .StatusBar = "Writing data from recordset..."
    End With
    
    With TargetCell.Cells(1, 1)
        r = .Row
        c = .Column
    End With
    
    With TargetCell.Parent
        .Range(.Cells(r, c), .Cells(.Rows.Count, c + rs.Fields.Count - 1)).Clear 
        ' clear existing contents
        ' write column headers
        For f = 0 To rs.Fields.Count - 1
            On Error Resume Next
            .Cells(r, c + f).Formula = rs.Fields(f).Name
            On Error GoTo 0
        Next f
        ' write records
        On Error Resume Next
        rs.MoveFirst
        On Error GoTo 0
        Do While Not rs.EOF
            r = r + 1
            For f = 0 To rs.Fields.Count - 1
                On Error Resume Next
                .Cells(r, c + f).Formula = rs.Fields(f).Value
                On Error GoTo 0
            Next f
            rs.MoveNext
        Loop
        .Rows(TargetCell.Cells(1, 1).Row).Font.Bold = True
        .Columns("A:IV").AutoFit
    End With
    
    With Application
        .StatusBar = False
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

The macro examples assumes that your VBA project has added a reference to the DAO object library.
You can do this from within the VBE by selecting the menu Tools, References and selecting Microsoft DAO x.xx Object Library.

 

Document last updated 2001-11-11 12:46:39      Printerfriendly version

User comments:
Ole P. from Norway wrote (2004-07-02 23:35:05 CET):
Re: Having trouble using example
I haven't been using DAO for many years since it is no longer updated by Microsoft who recommends using ADO instead of DAO.
Your problem might be caused by you using an Excel file format that is too new and not recognized by the "old" DAO.
Barry Pettis / bpettis@cso.atmel.com / iwrk4dedpr@msn.com from Colorado Springs, CO, USA wrote (2004-07-02 22:05:57 CET):
Having trouble using example
Hi,
I'm trying to become more versed in using the ADO and DAO objects. This is my first try. I'm trying your example

"Use a closed workbook as a database (DAO)"

I'm on a Win98Se PC and I've set a reference to Microsoft DAO 3.6.

I copied your code as is and made the changes to reflect my file names. However, it keeps saying that it can't open the file. At first it was on our corporate network and then I moved it to my c:\ drive with no luck.

 

Erlandsen Data Consulting     http://www.erlandsendata.no/   
Excel & VBA Tips   Copyright ©1999-2017    Ole P. Erlandsen   All rights reserved
E-mail Contact Address