我刚做的一个例子程序,你自己看看能不能用得上吧!
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
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
解决方案 »
- 急救啊!!!!vb6.0 升级到vb.net ,vs2010,ActiveRepots 7.0 ,报表升级全套方法?
- calendar 控件 在每次改变 月份的事件的时候,都有个“咚”的声音,如果去掉
- 一个关于文件操作的问题。。
- 我想在一个窗体的label上建立一个类似web的超级连接
- 如何将OCX控件打包,然后在客户端自动下载、注册?在线等待!
- vb的转换字符串问题
- 调试编译成执行文件均无问题,但打包后安装时出现问题!
- 用 ADODB.Connection 如何得到存储过程的返回值?
- 大虾帮忙!!!关于图像处理的问题.
- 求教!!vb怎么修改文件属性!!!!
- 有无办法例lable控件的Caption内容垂直对齐
- 添加SQL數據庫
我只要:用VB往dbase里写入数据的代码