Create Table from recordset

I have found some code on EE and placed it together but I cant figure out why I am getting a type mismatch error. Hopefully someone will see and be able to help...

Sub connectExchange()
    Dim cnn1 As ADODB.Connection
    Dim cmdExeproc As ADODB.Command
    Dim rstRecords As ADODB.Recordset
    Dim strcnn As String
    Dim varTest As Variant
   
    Set cnn1 = New ADODB.Connection
    'cnn1.Provider = "ExOLEDB.DataSource"
    'strcnn = "Provider=Microsoft.JET.OLEDB.4.0;Exchange 4.0;" & _
"MAPILEVEL=Outlook Address Book\;TABLETYPE=1;" & _
"DATABASE={B1C82C96-7149-4EDD-A709-8D7E66518332}; PROFILE=cgk0o7;"
    strcnn = "Provider=Microsoft.JET.OLEDB.4.0;Exchange 4.0;MAPILEVEL=Mailbox - GPM Job Request|;PROFILE=Outlook;TABLETYPE=0;TABLENAME=Archive DO NOT PROCESS;DATABASE=C:\DOCUME~1\cgk0o7\LOCALS~1\Temp\;"

    cnn1.Open strcnn
    cnn1.CursorLocation = adUseClient
   
    Set cmdExeproc = New ADODB.Command
    cmdExeproc.ActiveConnection = cnn1
    cmdExeproc.CommandText = "SELECT * FROM [Archive DO NOT PROCESS]"
   
    'Set cmdExeproc.ActiveConnection = cnn1
    'Set rstRecords = cmdExeproc.Execute
    'cmdExeproc.ActiveConnection = Nothing
    Set rstRecords = New ADODB.Recordset
    rstRecords.CursorLocation = adUseClient
    rstRecords.Open cmdExeproc, , adOpenKeyset, adLockReadOnly
   
   
   
    If rstRecords.EOF = True And rstRecords.BOF = True Then
       MsgBox ("There are no records meeting the specified criteria.")
       Exit Sub
    Else
       varTest = rstRecords.GetRows()
       'Kill "c:\test.xml"
       'rstRecords.Save "c:\test.xml", adPersistXML
       'Application.ImportXML "c:\test.xml", acStructureAndData
       AddToTable (rstRecords)     '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  Here is where I get the error "Type mismatch"
       Debug.Print "Got em!"
    End If
   
    rstRecords.Close
    Set rstRecords = Nothing
    cnn1.Close
    Set cnn1 = Nothing
    Set cmdExeproc = Nothing
   
End Sub

Public Function AddToTable(adoRec As ADODB.Recordset)

    Dim rst As ADODB.Recordset
    Dim fld As ADODB.Field

    'first clear out any old data in the temp table
    CurrentDb.Execute "DELETE * FROM tblTemp"

    'now open a recordset of that table so you can add new records
    Set rst = New ADODB.Recordset
    rst.Open Source:="SELECT * FROM tblTemp", _
             ActiveConnection:=CurrentProject.Connection, _
             CursorType:=adOpenKeyset, _
             LockType:=adLockOptimistic

    'now loop through the recordset you passed in and add
    'each record to the temp table
    adoRec.MoveFirst
    Do While Not adoRec.EOF
        rst.AddNew
            For Each fld In adoRec.Fields
                rst.Fields(fld.Name).Value = fld.Value
            Next
        rst.Update
        adoRec.MoveNext
    Loop

    'cleanup
    rst.Close
    Set rst = Nothing

End Function