我刚做的一个例子程序,你自己看看能不能用得上吧!
Public Sub MDB2DBF(ByVal dbfName As String, ByVal MDBName As String, ByVal TBName As String)
    Dim rdoCN As New rdoConnection, rdoRS As rdoResultset
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
    
    Dim rdoCNStr As String, rdoSQL As String
    Dim cnStr As String, SQLStr As String
    
    Dim cln As rdoColumn, i As Integer, nRC As Integer
    
    rdoCN.Connect = "SourceType=DBF;" _
        & "SourceDB=" & Left$(dbfName, InStrRev(dbfName, "\") - 1) & ";" _
        & "Driver={Microsoft Visual FoxPro Driver}"    rdoCN.CursorDriver = rdUseOdbc
    rdoCN.EstablishConnection "rdDriverNoPrompt"    dbfName = Right$(dbfName, Len(dbfName) - InStrRev(dbfName, "\")): dbfName = Left$(dbfName, InStr(dbfName, ".") - 1)
    rdoSQL = "select * from " & dbfName
    Set rdoRS = rdoCN.OpenResultset(rdoSQL, rdOpenKeyset, rdConcurRowVer)
    'rdoRS.MoveFirst
    
    
    cn.Provider = "Microsoft.Jet.OLEDB.3.51"
    cn.Open MDBName, "Admin"  '若没有该年次的库,应该在调用本SUB之前建立之
    
    SQLStr = "select * from " & TBName
    With rs
        Set .ActiveConnection = cn
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Open SQLStr
    End With
    
    On Error GoTo CopyErr
    
    'rs.MoveFirst        '数据传递
    rdoCN.BeginTrans
        Do Until rs.EOF
            rdoRS.AddNew
        
            For i = 0 To rdoRS.rdoColumns.Count - 1
                Set cln = rdoRS.rdoColumns(i)
                rdoRS(cln.Name).Value = LTrim(Trim(rs.Fields(cln.Name).Value))       '指定字段
            Next i
    
            rdoRS.Update
            rs.MoveNext
    
            nRC = nRC + 1
            If nRC = 300 Then
                rdoCN.CommitTrans
                rdoCN.BeginTrans
                nRC = 0
            End If
        Loop
        rdoCN.CommitTrans      '数据传递完毕        On Error GoTo 0
        Set rdoCN = Nothing: Set rdoRS = Nothing
        Set cn = Nothing: Set rs = Nothing
        
        Exit SubCopyErr:
        'Resume
        rdoCN.RollbackTrans
        Error Err.Number
        
End Sub
Private Sub cmd1_Click()
    Dim ofox As Object
    Dim strCreateDBF As String
    strCreateDBF = "create table test (准考证号 c(15),考生姓名 c(8))"
    Set ofox = CreateObject("VisualFoxPro.Application")
    ofox.DoCmd "set default to c:\windows\desktop"
    ofox.DoCmd strCreateDBF
    'ofox.Close
    Set ofox = Nothing
    
    Call MDB2DBF("c:\windows\desktop\test.dbf", "c:\windows\desktop\dbbakb.mdb", "考生信息表")
    MsgBox "ok!!!!!!!!!!!!!!!!!!!!!!"
End Sub