'RS  数据集

'TableName 需要写入 的本地表 名称

'RS 的字段名，必须全部存在于 TableName 。

Public Function RSinTable(RS As ADODB.Recordset, TableName As String) As Boolean  '从RS 写入到 本地表

    RSinTable = False
    On Error GoTo err
    Dim RSin As New ADODB.Recordset
    Dim SQLstr As String
    SQLstr = "Select * FROM " & TableName
    If Not RSopenW(RSin, SQLstr) Then GoTo err

    Dim 字段名 As String, i As Long
    If Not (RS.EOF And RS.BOF) Then RS.MoveFirst
    Do While Not RS.EOF
        RSin.AddNew
        For i = 0 To RS.Fields.Count - 1 '逐个字段
            字段名 = RS(i).name
            RSin(字段名) = RS(i)
        Next i
next1:  RSin.Update
        RS.MoveNext
    Loop
    RSin.Close
    RSinTable = True
    Exit Function
err:
    MsgBox " RSinTable 错误！err:" & err.Description

End Function

’=============================

'=============RS ADODB.Recordset========================
'打开ADODB.Recordset 只读
Public Function RSopenR(Res As ADODB.Recordset, SQLstr As String, Optional Con As ADODB.Connection = Nothing) As Boolean
    On Error GoTo err
    RSopenR = False
    If Con Is Nothing Then Set Con = CurrentProject.Connection
    DoCmd.SetWarnings False '关闭警告提示
    If Res.State Then Res.Close '确定关闭了原有 Res
    Res.Open SQLstr, Con, adOpenStatic, adLockReadOnly ', adAsyncFetchNonBlocking
    RSopenR = True
    Exit Function
err:
    MsgBox "'打开ADODB.Recordset只读 RSopenR(SQLstr=“" & SQLstr & "”) err：" & Chr(13) & err.Description
End Function

'打开ADODB.Recordset 读写
Public Function RSopenW(Res As ADODB.Recordset, SQLstr As String, Optional Con As ADODB.Connection = Nothing) As Boolean
    On Error GoTo err
    RSopenW = False
    If Con Is Nothing Then Set Con = CurrentProject.Connection
    If Res.State Then Res.Close '确定关闭了原有 Res
    Res.Open SQLstr, Con, adOpenDynamic, adLockOptimistic
    RSopenW = True
    Exit Function
err:
    MsgBox "'打开ADODB.Recordset读写 RSopenW(SQLstr=“" & SQLstr & "”) err：" & Chr(13) & err.Description
End Function

Public Function cnMe() As ADODB.Connection
    Set cnMe = CurrentProject.Connection
End Function