Ôñüðïò áíáêôÜ Ýíá áíôéêåßìåíï QueryDef áðü MS Access ÷ñçóéìïðïéþíôáò DAO

   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