Конвертировать набор записей ADODB в набор записей DAO в VBA - PullRequest
Новая
       85

Конвертировать набор записей ADODB в набор записей DAO в VBA

0 голосов
/ 16 апреля 2020

В настоящее время я создал этот код для преобразования набора записей ADODB в набор записей MS-ACCESS DAO в VBA.

Есть ли лучший способ сделать это? При таком подходе я создал временную таблицу в файле MS-ACCESS, из которой выполняется этот код. Таблица имеет тот же набор полей, что и исходный набор записей, и вставляет данные из набора записей ADODB. Затем, используя SELECT sql, я получаю данные из этой временной таблицы как набор записей DAO.

Мой код VBA 

Private Function ConvertRecordset_ADODB_to_DAO(rsADODB As ADODB.Recordset, Optional LimitRowCount As Integer = 100) As DAO.Recordset

    Dim Rs As ADODB.Recordset
    Set Rs = rsADODB

    Dim daoDBE As DAO.DBEngine
    Dim daoWS As DAO.Workspace
    Dim daoDB As DAO.Database
    Dim daoTABLE As DAO.TableDef
    Dim myFIELD As Field
    Dim myINDEX As Index
    Dim DB99 As Database
    Dim RS99 As Recordset
    vRs = "TempTable_99999"
    With CurrentDb
        For i = 0 To .TableDefs.Count - 1
            If .TableDefs(i).Name = vRs Then
                .TableDefs.Delete (vRs)
                Exit For
            End If
        Next
    End With
    Set daoTABLE = CurrentDb.CreateTableDef(vRs)

    Dim fName As String
    With daoTABLE
        For i = 0 To Rs.Fields.Count - 1
            fName = Rs.Fields(i).Name
            .Fields.Append .CreateField(fName, dbText)
        Next
    End With

    CurrentDb.TableDefs.Append daoTABLE

    Dim r As DAO.Recordset
    Set r = CurrentDb.OpenRecordset("select * from " & vRs)
    Dim rCount As Integer
    With Rs
        Do Until .EOF
            r.AddNew
            For i = 0 To .Fields.Count - 1
                r.Fields(i).Value = .Fields(i).Value
            Next
            r.Update
            rCount = rCount + 1
            If rCount >= LimitRowCount Then Exit Do
            .MoveNext
        Loop
    End With
    Rs.Close
    r.Close
    DoEvents
    Set r = CurrentDb.OpenRecordset("select * from " & vRs)
    Set ConvertRecordset_ADODB_to_DAO = r
    End Function
...