是否可以使用VBA“同步”不同Access文件中的两个表？
我创建了一个Access数据库，希望将其分发给一个小组。虽然我总是可以在excel中导出表，并在其中合并它们/附加数据，但有没有一种方法可以同步数据库，可能是使用VBA 为了进一步说明，在数据库应用程序中的一种形式中，可能存在一个sync按钮，单击会打开一个对话框以查找要与之同步的accdb。接下来，VBA将同步两个ACCDB之间具有相同结构的表是否可以使用VBA“同步”不同Access文件中的两个表？,vba,ms-access,Vba,Ms Access,我创建了一个Access数据库，希望将其分发给一个小组。虽然我总是可以在excel中导出表，并在其中合并它们/附加数据，但有没有一种方法可以同步数据库，可能是使用VBA 为了进一步说明，在数据库应用程序中的一种形式中，可能存在一个sync按钮，单击会打开一个对话框以查找要与之同步的accdb。接下来，VBA将同步两个ACCDB之间具有相同结构的表 这可能吗？洞察会很好。谢谢大家! 是的，这是完全可能的。下面是关于比较两个DBs和记录更改的一些注释 该程序要求模块顶部有以下内容： Dim strF
这可能吗？洞察会很好。谢谢大家! 是的，这是完全可能的。下面是关于比较两个DBs和记录更改的一些注释 该程序要求模块顶部有以下内容：
Dim strFileNew As String
Dim strFileOld As String
Dim strLog As String
Dim dbOld As Database
strLog = "log.txt"
strFileNew = "z:\docs\dbNew.mdb"
strFileOld = "z:\docs\dbOld.mdb"
Set dbOld = OpenDatabase(strFileOld)
Sub LogCompareDB(db As Database)
''References : Windows Script Host Object Model
'' This is set by default for a number of versions
'' : Microsoft DAO x.x Object Library
'' For 2010, the DAO library is called
'' :Microsoft Office 12.0 Access Database Engine Object Library
Dim tdf As TableDef
Dim rs0 As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim fld As DAO.Field
Dim idx As Index
Dim idxPrimary As Index
Dim strIndexList As String
Dim strIndex As String
Dim strID As String
Dim strSQL As String
Dim strChanged As String
Dim blnNew As Boolean
Dim fs As New FileSystemObject
Dim ts As TextStream
Set ts = fs.CreateTextFile(strLog, True)
''For each table in the old database
''(It would probably be a good idea to check the
''new database for added tables)
For Each tdf In db.TableDefs
'' Skip system tables
If Left(tdf.Name, 4) <> "MSys" Then
strIndex = vbNullString
Set idxPrimary = Nothing
strIndexList = vbNullString
''Get the primary index and index fields
For Each idx In tdf.Indexes
If idx.Primary = True Then
Set idxPrimary = idx
For Each fld In idx.Fields
strIndex = strIndex & " AND t0.[" & fld.Name _
& "] = t1.[" & fld.Name & "]"
strIndexList = strIndexList & "," & fld.Name
Next
strIndex = Mid(strIndex, 5)
End If
Next
''There is no basis for comparison if there is no index.
''A unique index would also be a possibility, but hey, let's
''not go over the top :)
If strIndex > vbNullString Then
''Select all records from the table for both databases
strSQL = "SELECT * FROM [;DATABASE=" & strFileNew & "].[" _
& tdf.Name & "] As t0 LEFT JOIN [" _
& tdf.Name & "] As t1 ON " & strIndex
Set rs0 = db.OpenRecordset(strSQL)
''A convenient list of fields from the old database
''It would probably be a good idea to check the
''new database for added fields.
strSQL = "SELECT * FROM [;DATABASE=" & strFileOld & "].[" _
& tdf.Name & "] As t0 WHERE 1=2"
Set rs1 = db.OpenRecordset(strSQL)
Do While Not rs0.EOF
strID = vbNullString
blnNew = False
''If the index fields are null, then it is a new record
For Each fld In idxPrimary.Fields
strID = strID & fld.Name & ": " & rs0("[t0." & fld.Name & "]") & vbCrLf
If IsNull(rs0("[t1." & fld.Name & "]")) Then
blnNew = True
End If
Next
If blnNew Then
''Write to log
ts.WriteLine "NEW RECORD " & strID & vbCrLf
Else
''Not a new record, so is it a changed record?
strChanged = vbNullString
For Each fld In rs1.Fields
''No need to check index fields, because they are equal
If InStr(strIndexList, fld.Name) = 0 Then
''Add null string for purposes of comparison ''trailing
If "" & rs0("[t0." & fld.Name & "]") <> "" & rs0("[t1." & fld.Name & "]") Then
strChanged = strChanged & vbCrLf _
& fld.Name & " Is: " & Trim(rs0("[t0." & fld.Name & "]")) _
& " Was: " & Trim(rs0("[t1." & fld.Name & "]"))
End If
End If
Next
If strChanged <> vbNullString Then
''Write to log
ts.WriteLine "CHANGED RECORD " & strID
ts.WriteLine strChanged & vbCrLf
End If
End If
rs0.MoveNext
Loop
Else
ts.WriteLine "NO PRIMARY INDEX " & tdf.Name & vbCrLf
End If
End If
Next
ts.Close
FollowHyperlink strLog
End Sub
是的，这是完全可能的。下面是关于比较两个DBs和记录更改的一些注释 该程序要求模块顶部有以下内容：
Dim strFileNew As String
Dim strFileOld As String
Dim strLog As String
Dim dbOld As Database
strLog = "log.txt"
strFileNew = "z:\docs\dbNew.mdb"
strFileOld = "z:\docs\dbOld.mdb"
Set dbOld = OpenDatabase(strFileOld)
Sub LogCompareDB(db As Database)
''References : Windows Script Host Object Model
'' This is set by default for a number of versions
'' : Microsoft DAO x.x Object Library
'' For 2010, the DAO library is called
'' :Microsoft Office 12.0 Access Database Engine Object Library
Dim tdf As TableDef
Dim rs0 As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim fld As DAO.Field
Dim idx As Index
Dim idxPrimary As Index
Dim strIndexList As String
Dim strIndex As String
Dim strID As String
Dim strSQL As String
Dim strChanged As String
Dim blnNew As Boolean
Dim fs As New FileSystemObject
Dim ts As TextStream
Set ts = fs.CreateTextFile(strLog, True)
''For each table in the old database
''(It would probably be a good idea to check the
''new database for added tables)
For Each tdf In db.TableDefs
'' Skip system tables
If Left(tdf.Name, 4) <> "MSys" Then
strIndex = vbNullString
Set idxPrimary = Nothing
strIndexList = vbNullString
''Get the primary index and index fields
For Each idx In tdf.Indexes
If idx.Primary = True Then
Set idxPrimary = idx
For Each fld In idx.Fields
strIndex = strIndex & " AND t0.[" & fld.Name _
& "] = t1.[" & fld.Name & "]"
strIndexList = strIndexList & "," & fld.Name
Next
strIndex = Mid(strIndex, 5)
End If
Next
''There is no basis for comparison if there is no index.
''A unique index would also be a possibility, but hey, let's
''not go over the top :)
If strIndex > vbNullString Then
''Select all records from the table for both databases
strSQL = "SELECT * FROM [;DATABASE=" & strFileNew & "].[" _
& tdf.Name & "] As t0 LEFT JOIN [" _
& tdf.Name & "] As t1 ON " & strIndex
Set rs0 = db.OpenRecordset(strSQL)
''A convenient list of fields from the old database
''It would probably be a good idea to check the
''new database for added fields.
strSQL = "SELECT * FROM [;DATABASE=" & strFileOld & "].[" _
& tdf.Name & "] As t0 WHERE 1=2"
Set rs1 = db.OpenRecordset(strSQL)
Do While Not rs0.EOF
strID = vbNullString
blnNew = False
''If the index fields are null, then it is a new record
For Each fld In idxPrimary.Fields
strID = strID & fld.Name & ": " & rs0("[t0." & fld.Name & "]") & vbCrLf
If IsNull(rs0("[t1." & fld.Name & "]")) Then
blnNew = True
End If
Next
If blnNew Then
''Write to log
ts.WriteLine "NEW RECORD " & strID & vbCrLf
Else
''Not a new record, so is it a changed record?
strChanged = vbNullString
For Each fld In rs1.Fields
''No need to check index fields, because they are equal
If InStr(strIndexList, fld.Name) = 0 Then
''Add null string for purposes of comparison ''trailing
If "" & rs0("[t0." & fld.Name & "]") <> "" & rs0("[t1." & fld.Name & "]") Then
strChanged = strChanged & vbCrLf _
& fld.Name & " Is: " & Trim(rs0("[t0." & fld.Name & "]")) _
& " Was: " & Trim(rs0("[t1." & fld.Name & "]"))
End If
End If
Next
If strChanged <> vbNullString Then
''Write to log
ts.WriteLine "CHANGED RECORD " & strID
ts.WriteLine strChanged & vbCrLf
End If
End If
rs0.MoveNext
Loop
Else
ts.WriteLine "NO PRIMARY INDEX " & tdf.Name & vbCrLf
End If
End If
Next
ts.Close
FollowHyperlink strLog
End Sub
只是个问题，雷莫。FileSystemObject和TetStream是用户定义的类型？您需要一个对Windows脚本主机对象模型的引用，它就在过程名称下面。上面的注释创建了一个更改列表，只有一种方式，没有更新。我在别处有，但只是很粗略。你能给我指一下那个参考资料吗？我真的很想了解更多关于刀的知识。谢谢。您使用的是哪个版本的MS Access？在MS Access 2010中，您只需添加对Windows脚本主机对象模型的引用，DAO引用已经存在。在“代码”窗口中，选择“工具、引用”并滚动列表，直到找到所需的引用，然后勾选它。正如大家感兴趣的一样，在2010年，DAO库被称为MicrosoftOffice12.0Access数据库引擎对象库只是一个问题，Remou。FileSystemObject和TetStream是用户定义的类型？您需要一个对Windows脚本主机对象模型的引用，它就在过程名称下面。上面的注释创建了一个更改列表，只有一种方式，没有更新。我在别处有，但只是很粗略。你能给我指一下那个参考资料吗？我真的很想了解更多关于刀的知识。谢谢。您使用的是哪个版本的MS Access？在MS Access 2010中，您只需添加对Windows脚本主机对象模型的引用，DAO引用已经存在。在“代码”窗口中，选择“工具、引用”并滚动列表，直到找到所需的引用，然后勾选它。2010年，DAO库被称为Microsoft Office 12.0 Access数据库引擎对象库。请解释您的答案。请解释您的答案。