Article ID: 147739
Article Last Modified on 10/11/2006
Sub GetQueryDef()
'This sub will get data from an Existing QueryDef in the Northwind
'database and place the data on sheet2.
Dim Db As Database
Dim Qd As QueryDef
Dim Rs As Recordset
Dim Ws As Object
Dim i As Integer
Dim Path as String
'Set the Path to the database. This line is useful because
'if your database is in another location, you just need to change
'it here and the Path Variable will be used throughout the code.
'
'If you're using Microsoft Office 97, the line should read:
'
'Path = "C:\Program Files\Microsoft
'Office\Office\Samples\Northwind.mdb"
'
Path = "C:\Msoffice\Access\Samples\Northwind.mdb"
'Set Ws
Set Ws = Sheets("Sheet1")
'This set of code will activate Sheet1 and clear any existing data.
'After clearing the data, it will select cell A1.
Ws.Activate
Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Range("A1").Select
'Set the Database and QueryDef. This QueryDef exists in the
'database.
Set Db = Workspaces(0).OpenDatabase(Path, ReadOnly:=True, _
Exclusive:=False)
Set Qd = Db.QueryDefs("Invoices")
'Create a new Recordset from the Query based on the stored
'QueryDef.
Set Rs = Qd.OpenRecordset()
'This loop will collect the field names and place them in the first
'row starting at "A1."
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next
'This line simply sets the font to bold for the headers.
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold _
=True
'The next line will get the data from the recordset and copy it
'into the Worksheet (Sheet1).
Ws.Range("A2").CopyFromRecordset Rs
'This next code set will just select the data region and auto-fit
'the columns
Sheets("Sheet1").Select
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Range("A1").Select
Qd.Close
Rs.Close
Db.Close
End Sub
176476 OFF: Office Assistant Not Answering Visual Basic Questions
DAO
Additional query words: 8.00 97 XL
Keywords: kbdtacode kbhowto kbprogramming KB147739