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.
The applications/code on this site are distributed as is and without warranties or liability. In no event shall the owner of the copyrights, or the authors of the applications/code be liable for any loss of profit, any problems or any damage resulting from the use or evaluation of the applications/code.