|
|||||||||
|
|||||||||
|
||||||||||||||||||||||||||||
» Use a closed workbook as a database (DAO) using VBA in Microsoft Excel
 | ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
|
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. | ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
|
READER COMMENTS (view all comments) |
||||||||||||||||
|
No comments have been submitted. | ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
 | ||||||||||||||||
Flipping Properties: Generate Instant Cash Profits in Real Estate
Lower Your Taxes - Big Time! : Wealth-Building, Tax Reduction Secrets from an IRS Insider
Real Estate Finance and Investments (Real Estate Finance and Investments, 11th Ed)
Microsoft Excel VBA Programming for the Absolute Beginner
Understanding Financial Statements
Special Edition Using Microsoft Excel 2002 | ||||||||||||||||
| ||||||||||||||||
RELATED MICROSOFT EXCEL TIPS
 |
• Excel VBA books
• Accounting books
• Business Plans
• MS Office books
• Taxes books
|
Terms
and Conditions of use |
|
|
Copyright © 2003 ExcelTip.com |
|