PPT97: Sample VB Code Uses DAO to Create Presentation

      Sub UseDAO()

         ' Used for error trapping.
         On Error Resume Next

         ' The name of the database to open.
         Const DATABASE_NAME As String = "nwind.mdb"
         Const DATABASE_LONG As String = "Northwind.mdb"

         ' Holds the path to the Office Directory.
         Dim strOfficePath As String
         Dim strNWpath As String

         ' Holds the database query.
         Dim strSQL As String

         ' Variables used in DAO.
         Dim db As Database
         Dim rs As Recordset
         Dim i, Num As Long
         Dim oPres As Presentation

         ' Get the path to the Powerpnt.exe file
         strOfficePath = Application.Path

         ' Check if the Northwind database is present, has a long file 
         ' name.
         strNWpath = UCase(strOfficePath _
            & "\Samples\" & DATABASE_LONG)

         ' Open the Northwind database.
         Err.Clear
         Set db = DBEngine.OpenDatabase(strNWpath)

         ' Check if error occured when opening Northwind database.
         If Err.Number <> 0 Then

            ' Use the short file name.
            strNWpath = UCase(Left(strOfficePath, Len(strOfficePath) - 6) _
               & "\Samples\" & DATABASE_NAME)

            ' Open the Northwind database using the short file name.
            Err.Clear
            Set db = DBEngine.OpenDatabase(strNWpath)
            If Err.Number <> 0 Then
               MsgBox Err.Description, vbCritical, "Database Not Found"
               End
            End If
         End If

         ' Compose the query.
         ' Finds products that cost over 50 dollars.
         strSQL = "SELECT Products.ProductName, Products.UnitPrice" _
            & " FROM Products WHERE UnitPrice >= 50"

         ' Get the record set.
         Err.Clear
         Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)

         ' Check if error occured reading the table.
         If Err.Number <> 0 Then

            ' If error occurred display message, close the database, and
            ' exit from the macro.
            MsgBox Err.Description, vbCritical, "Unable To Open Table"
            db.Close
            End
         End If

         ' Move to the last record in the record set.
         rs.MoveLast

         ' Assign num the total number of records.
         Num = rs.RecordCount

         ' Move to the first record.
         rs.MoveFirst

         ' Create a presentation and insert a slide.
         Set oPres = Presentations.Add()

         ' Create a new slide using the two column text layout.
         oPres.Slides.Add 1, ppLayoutTwoColumnText

         ' Add a title to the slide.
         oPres.Slides(1).Shapes.Title.TextFrame.TextRange = "Products " _
         & "over 50 dollars"

         ' Set the font size for the shapes.
         With oPres.Slides(1).Shapes(2).TextFrame.TextRange
            .Font.Size = 24
            .ParagraphFormat.Bullet = msoFalse
         End With
         With oPres.Slides(1).Shapes(3).TextFrame.TextRange
            .Font.Size = 24
            .ParagraphFormat.Bullet = msoFalse
         End With

         ' Add a tab stop in the price list box.
         With oPres.Slides(1).Shapes(3).TextFrame.Ruler
            .TabStops.Add ppTabStopDecimal, 72
         End With

         ' Loop through the records in the record set.
         For i = 1 To Num
            With oPres.Slides(1)

               ' Adds the Product Name to the slide.
               With .Shapes(2).TextFrame
                  .TextRange = .TextRange & rs.Fields(0).Value & Chr(13)
               End With

               ' Adds the price of the item to the slide.
               With .Shapes(3).TextFrame
                  ' Create a decimal tab at one inch.
                  .TextRange = .TextRange & Chr(9) & Chr(9) _
                     & Format(rs.Fields(1).Value, "####0.00") & Chr(13)
               End With

            End With

            ' Move the record in the record set.
            rs.MoveNext
         Next i

         ' Close the database.
         db.Close

      End Sub