有二个access数据库，能不能把其中一个库里的一个表通过代码复制到另一个库里去。

[52694]

有二个access数据库，能不能把其中一个库里的一个表通过代码复制到另一个库里去。

[海牛]

当然可以！我都写过，而且是所有表，还要去除重复数据！

[海牛]

要源代码？
Email To [e-mail]

[52694]

Rick110AAA(海牛猪猪) ( )

能指点下吗？谢谢了

[52694]

兄弟，邮件发了，这里也回复了

到底怎样啊

我可是急着用的啊

[kangqing]

兄弟也给我一份吧
想要分告诉我我可以给你分的 [e-mail]
我昨天才开始学习vb明天就要开始用vb工做了

[52694]

天....

[honyuan]

对两个数据库分别创建工作区并在其中创建表名然后用SQL写入便可

[hemeijun81]

兄弟：能否给我发一份源代码，我也有这样的问题没有解决！谢谢！
[e-mail]

[海牛]

'给你两个函数
'函数一 SaveDataToTable1
'参数 strTable 是目的表
'参数 objRs 是源表的所有数据的数据集，你要先从源表中将所有数据都读出来。
'
'函数二 CheckSameDataByTable
'是在 函数SaveDataToTable1 中内部调用，可以不用知道参数的意思。
'
'
'直接调用过程 SaveDataToTable1
'有问题再QQ我！69320713
Public Sub SaveDataToTable1(ByVal strTable As String, objRs As ADODB.Recordset)
On Error GoTo Err1
Dim I As Long
Dim K As Long
Dim lC As Long
Dim bTableEmpty As Boolean
Dim strSql As String, strName As String, strErr As String, strValue As String

Dim objRsTmp As New ADODB.Recordset

If objRs.EOF = True Then
Set objRsTmp = Nothing
Exit Sub
End If

strSql = "Select Top 1 * From [" & strTable & "]"
objRsTmp.Open strSql, objCon(0), adOpenKeyset, adLockOptimistic, &H1
bTableEmpty = (objRs.Fields(0).Value = 0)
K = objRs.Fields.Count - 1
lC = 0
Do Until objRs.EOF = True Or intDo = -1
If bTableEmpty = False Then
If CheckSameDataByTable(objRs.Fields, strTable) = False Then
objRsTmp.AddNew
For I = 0 To K
If objRs.Fields(I).Properties("ISAUTOINCREMENT").Value = "False" And IsNull(objRs.Fields(I).Value) = False Then
strName = objRs.Fields(I).Name
objRsTmp.Fields(strName).Value = objRs.Fields(I).Value
End If
Next I
objRsTmp.Update
DoEvents
End If
Else
objRsTmp.AddNew
For I = 0 To K
If objRs.Fields(I).Properties("ISAUTOINCREMENT").Value = "False" And IsNull(objRs.Fields(I).Value) = False Then
strName = objRs.Fields(I).Name
objRsTmp.Fields(strName).Value = objRs.Fields(I).Value
End If
Next I
objRsTmp.Update
DoEvents
End If
lC = lC + 1
objRs.MoveNext
Loop
objRsTmp.Close
Set objRsTmp = Nothing
Exit Sub
Err1:
If Err.Number <> 94 Then
Resume Next
Else
strValue = " "
Resume Next
End If
End Sub

Public Function CheckSameDataByTable(objFields As Fields, ByVal strTable As String) As Boolean
Dim I As Long, K As Long
Dim strSql As String, sP As String, strV As String
Dim objRsTmp As ADODB.Recordset
Dim intType As DataTypeEnum
On Error GoTo Err1

K = objFields.Count - 1
strSql = "Select Count(*) From [" & strTable & "] Where "

For I = 0 To K
If objFields(I).Properties("ISAUTOINCREMENT").Value = "False" And IsNull(objFields(I).Value) = False Then
intType = objFields(I).Type
If intType = adVarChar Or intType = adVarWChar Or intType = adLongVarWChar Then
sP = "'"
Else
If intType = adDate Then
sP = "#"
Else
sP = ""
End If
End If
strV = objFields(I).Value
strV = Replace(strV, "'", "''")
strSql = strSql & "[" & objFields(I).Name & "]=" & sP & strV & sP & " And "
End If
Next I
DoEvents
strSql = Mid(strSql, 1, Len(strSql) - 4)
Set objRsTmp = objCon(0).Execute(strSql)
CheckSameDataByTable = (objRsTmp.Fields(0).Value <> 0)
objRsTmp.Close
Set objRsTmp = Nothing
Exit Function
Err1:
objRsTmp.Close
Set objRsTmp = Nothing
CheckSameDataByTable = True
End Function