使用VBA读写dbf数据库

1、在dbf数据库中插入一行记录

Sub InsertDBFData(rowNo, dbfFileName, dbfFileDir)

    Dim workSht As Worksheet

    Dim cn As New ADODB.Connection      '定义数据链接对象，保存连接数据库信息

    Dim rs As New ADODB.Recordset       '定义记录集对象，保存数据表

    Dim sql As String

    Set workSht = ThisWorkbook.Worksheets("测试数据")

    Set cn = CreateObject("adodb.connection")

    Set rs = CreateObject("adodb.recordset")

    '两种连接dbf数据库的方式

    'cnnstr = "driver={microsoft visual foxpro driver};sourcetype=dbf;sourcedb=" & dbfFileDir & ";exclusive=no;"

    'cn.Open cnnstr

    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='dbase 5.0';Data Source = " & dbfFileDir

    sql = "select * from " & dbfFileName

    rs.Open sql, cn, 3, 3      '可读写

    rs.addnew

    Dim rec_num, trader

    rec_num = workSht.Cells(rowNo, 1)

    trader = workSht.Cells(rowNo, 2)

    rs("rec_num") = rec_num

    rs("trader") = trader

    rs.Update

    rs.Close

    cn.Close

    Set rs = Nothing

    Set cn = Nothing

End Sub

Sub插入一条数据()

    Dim dbfFileName, dbfFileDir As String

    Dim row As Long

    dbfFileName = " order.dbf"

    dbfFileDir = "C:\Program Files\test"

    row = 1

    Call InsertDBFData(row, dbfFileName, dbfFileDir)

End Sub

2、在dbf数据库中删除最后一行记录

Sub删除最后一行记录()

    Dim dbfFileName As String

    Dim dbfFileDir As String

    dbfFileName = "order.dbf"

    dbfFileDir = "C:\Program Files\test"

    Call DeleteRecord(dbfFileName, dbfFileDir)

    MsgBox "Completed."

End Sub

Sub DeleteRecord(dbfFileName, dbfFileDir)

    Dim sql

    Dim cn As New ADODB.Connection      '定义数据链接对象，保存连接数据库信息

    Dim rs As New ADODB.Recordset       '定义记录集对象，保存数据表

    Dim cnnstr

    Set cn = CreateObject("adodb.connection")

    Set rs = CreateObject("adodb.recordset")

    cnnstr = "driver={microsoft visual foxpro driver};sourcetype=dbf;sourcedb=" & dbfFileDir & ";exclusive=no;"

    cn.Open cnnstr

    sql = "select * from " & dbfFileName

    rs.Open sql, cn, 3, 3

    rs.MoveLast

    rs.Delete

    rs.Update

    rs.Close

    cn.Close

    Set rs = Nothing

    Set cn = Nothing

End Sub

3、获取dbf数据库中某条记录的值后,写入excel中

Sub获取Remark域的取值()

    Dim dbfFileName As String

    Dim dbfFileDir As String

    Dim row As Long

    dbfFileName = "feedback.dbf"

    dbfFileDir = "C:\Program Files\test"

    Application.Wait (Now + TimeValue("00:00:03"))

    row = 1

    Call ReturnRemark(row, dbfFileName, dbfFileDir)

    MsgBox "Completed."

End Sub

Function ReturnRemark(rowNo, dbfFileName, dbfFileDir)

    Dim workSht As Worksheet

    Dim cn As New ADODB.Connection      '定义数据链接对象，保存连接数据库信息

    Dim rs As New ADODB.Recordset       '定义记录集对象，保存数据表

    Dim cnnstr, sql, rec_num As String

    Set workSht = ThisWorkbook.Worksheets("测试数据")

    Set cn = CreateObject("adodb.connection")

    Set rs = CreateObject("adodb.recordset")

    cnnstr = "driver={microsoft visual foxpro driver};sourcetype=dbf;sourcedb=" & dbfFileDir & ";exclusive=no;"

    cn.Open cnnstr

    sql = "select * from " & dbfFileName

    rs.Open sql, cn, 3, 3

    rec_num = workSht.Cells(rowNo, 1)

    rs.Find "rec_num = " & rec_num

    workSht.Cells(rowNo, 3) = Trim(rs("remark"))

    rs.Close

    cn.Close

    Set rs = Nothing

    Set cn = Nothing

End Function