CreateQueryDef Method, OpenRecordset Method, and SQL Property Example (Client/Server)

This example uses the CreateQueryDef and OpenRecordset methods and the SQL property to query the table of titles in the Microsoft SQL Server sample database Pubs and return the title and title identifier of the best-selling book. The example then queries the table of authors and instructs the user to send a bonus check to each author based on his or her royalty share (the total bonus is $1,000 and each author should receive a percentage of that amount).

Sub ClientServerX2()

   Dim dbsCurrent As Database
   Dim qdfBestSellers As QueryDef
   Dim qdfBonusEarners As QueryDef
   Dim rstTopSeller As Recordset
   Dim rstBonusRecipients As Recordset
   Dim strAuthorList As String

   ' Open a database from which QueryDef objects can be 
   ' created.
   Set dbsCurrent = OpenDatabase("DB1.mdb")

   ' Create a temporary QueryDef object to retrieve
   ' data from a Microsoft SQL Server database.
   Set qdfBestSellers = dbsCurrent.CreateQueryDef("")
   With qdfBestSellers
      .Connect = "ODBC;DATABASE=pubs;UID=sa;PWD=;" & _
          "DSN=Publishers"
      .SQL = "SELECT title, title_id FROM titles " & _
         "ORDER BY ytd_sales DESC"
      Set rstTopSeller = .OpenRecordset()
      rstTopSeller.MoveFirst
   End With

   ' Create a temporary QueryDef to retrieve data from
   ' a Microsoft SQL Server database based on the results from
   ' the first query.
   Set qdfBonusEarners = dbsCurrent.CreateQueryDef("")
   With qdfBonusEarners
      .Connect = "ODBC;DATABASE=pubs;UID=sa;PWD=;" & _
         "DSN=Publishers"
      .SQL = "SELECT * FROM titleauthor " & _
         "WHERE title_id = '" & _
         rstTopSeller!title_id & "'"
      Set rstBonusRecipients = .OpenRecordset()
   End With

   ' Build the output string.
   With rstBonusRecipients
      Do While Not .EOF
         strAuthorList = strAuthorList & "  " & _
            !au_id & ":  $" & (10 * !royaltyper) & vbCr
         .MoveNext
      Loop
   End With

   ' Display results.
   MsgBox "Please send a check to the following " & _
      "authors in the amounts shown:" & vbCr & _
      strAuthorList & "for outstanding sales of " & _
      rstTopSeller!Title & "."

   rstTopSeller.Close
   dbsCurrent.Close

End Sub