如何将一个FOX表中的数据导入ACCESS表中！

Question

兄弟，自己看代码，我程序中的，没总是的，不过你要仔细修剪，好些东西你不一定有用的，另外，我已将该当窗体发送至你的邮箱，有助你的理解
HAVE  FUN！！！
@_@Function DataGet(strDBName As String, strPathName As String, Tablename As String, strScr As String) As Boolean
    Dim recTable As DAO.Recordset
    Dim recNewTable As DAO.Recordset
    Dim recTem As DAO.Recordsets
    Dim dbOld As DAO.Database
    Dim dbNew As DAO.Database
    Dim strNewTableName As String
    Dim intx As Integer
    Dim qureyTable As DAO.QueryDef
    Dim strSql As String
    Dim strCondition As String
    Dim intRecNumber As Integer
    Select Case Tablename
        Case "A1.DBF":
            strNewTableName = "A1"
        Case "A2_1.DBF":
            strNewTableName = "A2_1"
        Case "A2_2.DBF":
            strNewTableName = "A2_2"
        Case "A1.DBF":
            strNewTableName = "A1"
        Case "A3.DBF":
            strNewTableName = "A3"
        Case "A4.DBF":
            strNewTableName = "A4"
        Case "A5.DBF":
            strNewTableName = "A5"
        Case "A6.DBF":
            strNewTableName = "A6"
        Case "A7.DBF":
            strNewTableName = "A7"
        Case "A8.DBF":
            strNewTableName = "A8"
        Case "A9.DBF":
            strNewTableName = "A9"
        Case "A10.DBF":
            strNewTableName = "A10"
        Case "A11.DBF":
            strNewTableName = "A11"
        Case "A12.DBF":
            strNewTableName = "A12"
        Case "A131.DBF":
            strNewTableName = "A131"
        Case "A132.DBF":
            strNewTableName = "A132"
        Case "B1.DBF":
            strNewTableName = "B1"
        Case "B2.DBF":
            strNewTableName = "B2"
        Case "B3.DBF":
            strNewTableName = "B3"
        Case "B4.DBF":
            strNewTableName = "B4"
        Case "B5.DBF":
            strNewTableName = "B5"
        Case "B6.DBF":
            strNewTableName = "B6"
        Case "B7.DBF":
            strNewTableName = "B7"
        Case "B8.DBF":
            strNewTableName = "B8"
        Case "B9.DBF":
            strNewTableName = "B9"
        Case "B10.DBF":
            strNewTableName = "B10"
        Case "B11.DBF":
            strNewTableName = "B11"
        Case "B12.DBF":
            strNewTableName = "B12"
        Case "B13.DBF":
            strNewTableName = "13"
        Case "B14.DBF":
            strNewTableName = "B14"
        Case "C1.DBF":
            strNewTableName = "C1"
        Case "C2.DBF":
            strNewTableName = "C2"
        Case "C3.DBF":
            strNewTableName = "C3"
        Case "C2.DBF":
            strNewTableName = "C2"
        Case "C4.DBF":
            strNewTableName = "C4"
        Case "C5.DBF":
            strNewTableName = "C5"
        Case "C6.DBF":
            strNewTableName = "C6"
        Case "C7.DBF":
            strNewTableName = "C7"
        Case "C8.DBF":
            strNewTableName = "C8"
        Case "C9.DBF":
            strNewTableName = "C9"
        Case "C10.DBF":
            strNewTableName = "C10"
        Case "M0MLA.DBF":
            strNewTableName = "M0MLA"
        Case "M1MLA.DBF":
            strNewTableName = "M1MLA"
        Case "M2MLA.DBF":
            strNewTableName = "M2MLA"
        Case "M3MLA.DBF":
            strNewTableName = "M3MLA"
        Case "M4MLA.DBF":
            strNewTableName = "M4MLA"
        Case "M5MLA.DBF":
            strNewTableName = "M5MLA"
        Case "MDMLA.DBF":
            strNewTableName = "MDMLA"
        Case "MNMLA.DBF":
            strNewTableName = "MNMLA"
        Case "MZMLA.DBF":
            strNewTableName = "MZMLA"
        Case Else:
            strNewTableName = ""
    End Select
    
    If strNewTableName <> "" Then
        On Error Resume Next
        strScr = strScr & Chr(10) & Chr(13) & Tablename & "------------->" & strNewTableName
        
        DataOutput.DatabaseName = strDBName
        DataOutput.RecordSource = strNewTableName
        DataOutput.Refresh
        DataInput.DatabaseName = strPathName
        DataInput.RecordSource = Tablename
        DataInput.Refresh
        Set recTable = DataInput.Database.OpenRecordset(Tablename)
        Set recNewTable = DataOutput.Database.OpenRecordset(strNewTableName)
        Set qureyTable = DataOutput.Database.CreateQueryDef("")
        On Error Resume Next
            recNewTable.MoveLast
            recTable.MoveFirst
        On Error GoTo errs
        Do While Not recTable.EOF
            If Not ExistRec(recTable, strDBName, strNewTableName) Then
                recNewTable.AddNew
                intRecNumber = intRecNumber + 1
                For x = 0 To recTable.Fields.Count - 1
                    recNewTable.Fields(x).Value = recTable.Fields(x).Value
                Next x
                recNewTable.Update
            End If
            recTable.MoveNext
        Loop
        strScr = strScr & Chr(10) & Chr(13) & "        转换记录" & intRecNumber & "条"
        Debug.Print Tablename & "------------->" & strNewTableName
        Debug.Print "   转换并导入记录" & intRecNumber & "条"
        DataInput.Database.Close
        DataOutput.Database.Close
    Else
        strScr = strScr & Chr(10) & Chr(13) & "不能转换文件" & Tablename
    End If
    Exit Function
errs:
        strScr = strScr & Chr(10) & Chr(13) & "转换出现错误:" & Err.Description
End Function
Function ExistRec(rec As DAO.Recordset, strDatabaseName As String, strTableName As String) As Boolean
     Dim recTem As DAO.Recordset
     Dim recNew As DAO.Recordset
     Dim bolSame As Boolean
     Dim bolNoSame As Boolean
     Dim intx As Integer
     bolSame = False
     DataQuery.DatabaseName = strDatabaseName
    DataQuery.RecordSource = strTableName
    DataQuery.Refresh
    Set recNew = DataQuery.Database.OpenRecordset(strTableName)
    Do While Not recNew.EOF
        bolNoSame = False
        For intx = 0 To recNew.Fields.Count - 1
            If recNew.Fields(intx).Value <> rec.Fields(intx).Value Then
                bolNoSame = True
            End If
        Next intx
        If bolNoSame = False Then
            ExistRec = True
            Exit Function
        End If
        recNew.MoveNext
    Loop
    DataQuery.Database.Close
    ExistRec = False
End FunctionPrivate Sub cmdCancel_Click()
Unload Me
End SubPrivate Sub cmdInput1_Click()
    Dim strFilename As String
    Dim intx As Integer
    Dim intFlag As Integer
    diaFileName.ShowOpen
    strFilename = diaFileName.FileName
    If strFilename <> "" Then
        txtInputInfo.Text = strFilename
        intx = Len(strFilename)
        Do While intx > 1
            If Mid(strFilename, intx, 1) = "\" Then
                intFlag = intx
                intx = 0
            Else
                intx = intx - 1
            End If
            
        Loop
        If intFlag > 0 Then
            lblFileName.Caption = Mid(strFilename, intFlag + 1, Len(strFilename) - intFlag)
            lblPath.Caption = Mid(strFilename, 1, intFlag - 1)
        End If
    End If
    
End SubPrivate Sub cmdInput2_Click()
Dim strFilename As String
    Dim intx As Integer
    Dim intFlag As Integer
    diaFileName.ShowOpen
    strFilename = diaFileName.FileName
    If strFilename <> "" Then
        txtInputInfo.Text = strFilename
        intx = Len(strFilename)
        Do While intx > 1
            If Mid(strFilename, intx, 1) = "\" Then
                intFlag = intx
                intx = 0
            Else
                intx = intx - 1
            End If
            
        Loop
        If intFlag > 0 Then
            lblFileName.Caption = Mid(strFilename, intFlag + 1, Len(strFilename) - intFlag)
            lblPath.Caption = Mid(strFilename, 1, intFlag - 1)
        End If
    End If
    
End SubPrivate Sub cmdOK_Click()
    If optPath.Value = True Then
        SetInfo lblPath.Caption
    Else
        SetInfo lblPath.Caption, lblFileName.Caption
    End If
End Sub
Function SetInfo(PathName As String, Optional FileName As String) As Boolean
    Dim strTemFileName As String
    Dim strResultDec As String
    If FileName <> "" Then
        DataGet strDBFileName, PathName, FileName, strResultDec
        
    Else
        strTemFileName = Dir("*.dbf")
        Do While strTemFileName <> ""
            DataGet strDBFileName, lblPath.Caption, strTemFileName, strResultDec
            strTemFileName = Dir
        Loop
    End If
   ' MsgBox strResultDec
   If chkReport.Value > 0 Then
        frmChangeReport.richShow.Text = strResultDec
        frmChangeReport.Show
    Else
        MsgBox "导入成功"
    End If
    Unload Me
End Function
'
'Private Sub Command1_Click()
    'CreateDatabaseX "c:\tem\new.mdb", "ads"
'    DataGet strDBFileName, "c:\tem", "SY-A3.DBF"
    'SQLQurey2 "create database", "c:\tem\cs.mdb"
'End SubPrivate Sub Form_Load()
cmdInput1.Enabled = False
chkReport.Value = 1
End SubPrivate Sub optFile_Click()
    If optFile.Value = True Then
        cmdInput1.Enabled = True
        cmdInput2.Enabled = False
        lblFileName.BackColor = &H80000009
        lblPath.BackColor = &H8000000F
    Else
        cmdInput1.Enabled = False
        cmdInput2.Enabled = True
        lblFileName.BackColor = &H8000000F
        lblPath.BackColor = &H80000009
    End If
    
End SubPrivate Sub optPath_Click()
    If optPath.Value = False Then
        cmdInput1.Enabled = True
        cmdInput2.Enabled = False
        lblFileName.BackColor = &H80000009
        lblPath.BackColor = &H8000000F
    Else
        cmdInput1.Enabled = False
        cmdInput2.Enabled = True
        lblFileName.BackColor = &H8000000F
        lblPath.BackColor = &H80000009
    End If
End SubPrivate Sub txtInputInfo_Change()
    If txtInputInfo.Text <> "" Then cmdOK.Enabled = True Else cmdOK.Enabled = False
End Sub

Answer 1

Dim adoConnection As New ADODB.Connection
'一定要用 Microsoft.Jet.OLEDB.4.0,不要用 3.51,但 MDB 文件可以是 Access97
adoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\db4.mdb;Persist Security Info=False"'adoConnection.Execute "SELECT * INTO CopyOfAnimals FROM animals IN ''[dBASE IV;DATABASE=d:\dbfs\]"
'adoConnection.Execute "INSERT INTO CopyOfAnimals SELECT * FROM animals IN ''[dBASE IV;DATABASE=d:\dbfs\]"'一定要用 Microsoft.Jet.OLEDB.4.0,不要用 3.51,但 MDB 文件可以是 Access97
'adoConnection.Execute "SELECT * INTO CopyOfAnimals FROM [dBASE III;DATABASE=d:\dbfs\].animals.dbf"
adoConnection.Execute "INSERT INTO CopyOfAnimals SELECT * FROM [dBASE III;DATABASE=d:\dbfs\].animals.dbf" 

Answer 2

太复杂！为什么不用FOXPRO把它存为FOXPRO

Answer 3

太复杂！为什么不用FOXPRO把它存为FOXPRO 的DBF文件，再用ACCESS的导入功能把它导入到ACCESS数据库中？

Answer 4

'只讨论编程实现
INSERT INTO AccessT1 
SELECT [T1].* FROM [dBASE III;DATABASE=d:\dbfs\].XXX.dbf AS T1
WHERE NOT [T1].[ID] IN ([AccessT1].[ID])INSERT INTO AccessT1 
SELECT [T1].* FROM [dBASE IV;DATABASE=d:\dbfs\].XXX.dbf AS T1
WHERE NOT [T1].[ID] IN ([AccessT1].[ID])

Answer 5

wyo(欧亚大陆桥),那好象是手工操作吧？
对了，给你的分收到了吧？