I Have a Word VBA Macro That Fills a Table. I Need to Convert it to PowerPoint VBA

I have a Word VBA Macro That I use to Fill a Table in Word by Pulling Data from an Access Database.

I have the same need to fill a table in Powerpoint by pulling from an Access Table.

The Code is below, it works in WORD, but When I try to Execute it in PowerPoint, I get an error, shown below. Can Somebody please tell me what I'm doing wrong? Thanks.

Rex

Option Explicit

Sub FillTable()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim strConn As String
    Dim Doca As Document
    Dim para As Paragraph
    Dim rng As Range
    Dim strDateText As String
    Dim tbl As Table
    Dim rw As Word.Row
    Set Doca = ActiveDocument
    
     Set cn = New ADODB.Connection
    cn.Provider = "Microsoft.ACE.OLEDB.12.0"
    cn.Open "P:\KO Quality\KO Reporting\KO Weekly Reporting Data\Current Reporting Database\KO Quality Master 2008 Linked.accdb"

    Set rs = New ADODB.Recordset
    
    rs.Open "L2CAR_KOJ_Wood_Table", cn, adOpenDynamic, adLockOptimistic, adCmdTable
    Set tbl = Doca.Tables.Add(Doca.Bookmarks("\EndOfDoc").Range, 1, 5)
    tbl.Cell(1, 1).Range.Text = "Activity Type"
    tbl.Cell(1, 2).Range.Text = "Number"
    tbl.Cell(1, 3).Range.Text = "Start Date"
    tbl.Cell(1, 4).Range.Text = "Status"
    tbl.Cell(1, 5).Range.Text = "Defect Code"

    
    
    Do Until rs.EOF
        Set rw = tbl.Rows.Add
        rw.Cells(1).Range.Text = rs.Fields("Activity Type").Value
        rw.Cells(2).Range.Text = rs.Fields("Number").Value
        rw.Cells(3).Range.Text = rs.Fields("Start Date").Value
        rw.Cells(4).Range.Text = rs.Fields("Status").Value
        rw.Cells(5).Range.Text = rs.Fields("Defect Code").Value

        
        
        rs.MoveNext
    Loop
    rs.Close
    cn.Close
End Sub

Select allOpen in new window

PowerPoint-Error.jpg