我已经构建了一个宏,它将大约10个不同表中的值从一个数据库移动到另一个数据库。它需要一个唯一的标识符,所以说列“nid”并检查它是否已经存在于新数据库中,如果没有匹配它会移动数据如果有匹配且它已经存在则不会。
这个宏工作正常但是,我希望它检查该值是否已经存在,以及它是否检查每个列是否有任何更改以及是否有更改值以移动新值。例如,在新数据库上更新原始数据库的密码。
有些表格最多有50列,因此手动循环每一列将是一个非常长的宏,我想知道是否有更简单的方法来做到这一点?如果不是,我将如何循环它们?
这是我的一个表的宏:
Public Function update1()
'Open source database
Dim dSource As Database
Set dSource = CurrentDb
'Open dest database
Dim dDest As Database
Set dDest = DAO.OpenDatabase("C:\Users\simon\Documents\SellerDeck 2013\Sites\dest\ActinicCatalog.mdb")
'Open source recordset
Dim rSource As Recordset
Set rSource = dSource.OpenRecordset("Address", dbOpenForwardOnly)
'Open dest recordset
Dim rDest As Recordset
Set rDest = dDest.OpenRecordset("Address", dbOpenDynaset)
'Loop through source recordset
While Not rSource.EOF
'Look for record in dest recordset
rDest.FindFirst "nCustomerID = " & rSource.Fields("nCustomerID") & ""
'If not found, copy record
If rDest.NoMatch Then
rDest.AddNew
rDest.Fields("nCustomerID") = rSource.Fields("nCustomerID")
rDest.Fields("sName") = rSource.Fields("sName")
rDest.Fields("sLine2") = rSource.Fields("sLine2")
rDest.Fields("sLine4") = rSource.Fields("sLine4")
rDest.Fields("nCountryID") = rSource.Fields("nCountryID")
rDest.Fields("bValidInvoiceAddress") = rSource.Fields("bValidInvoiceAddress")
rDest.Fields("bValidDeliveryAddress") = rSource.Fields("bValidDeliveryAddress")
rDest.Fields("nStateID") = rSource.Fields("nStateID")
rDest.Fields("bExemptTax1") = rSource.Fields("bExemptTax1")
rDest.Fields("sExemptTax1Number") = rSource.Fields("sExemptTax1Number")
rDest.Fields("bExemptTax2") = rSource.Fields("bExemptTax2")
rDest.Fields("sExemptTax2Number") = rSource.Fields("sExemptTax2Number")
rDest.Fields("bPurge") = rSource.Fields("bPurge")
rDest.Fields("bChanged") = rSource.Fields("bChanged")
rDest.Fields("nID") = rSource.Fields("nID")
rDest.Fields("nTax1ID") = rSource.Fields("nTax1ID")
rDest.Fields("nTax2ID") = rSource.Fields("nTax2ID")
rDest.Fields("nResidential") = rSource.Fields("nResidential")
rDest.Fields("sCompanyName") = rSource.Fields("sCompanyName")
rDest.Fields("sLine1") = rSource.Fields("sLine1")
rDest.Fields("sLine3") = rSource.Fields("sLine3")
rDest.Fields("sPostalCode") = rSource.Fields("sPostalCode")
rDest.Fields("sEmailAddress") = rSource.Fields("sEmailAddress")
rDest.Fields("sFaxNumber") = rSource.Fields("sFaxNumber")
rDest.Fields("sFirstName") = rSource.Fields("sFirstName")
rDest.Fields("sFullName") = rSource.Fields("sFullName")
rDest.Fields("sLastName") = rSource.Fields("sLastName")
rDest.Fields("sMobileNumber") = rSource.Fields("sMobileNumber")
rDest.Fields("sSalutation") = rSource.Fields("sSalutation")
rDest.Fields("sTelephoneNumber") = rSource.Fields("sTelephoneNumber")
rDest.Fields("sTitle") = rSource.Fields("sTitle")
rDest.Update
End If
'Next source record
rSource.MoveNext
Wend
'Close dest recordset
rDest.Close
Set rDest = Nothing
'Close source recordset
rSource.Close
Set rSource = Nothing
'Close dest database
dDest.Close
Set dDest = Nothing
'Close source database
dSource.Close
Set dSource = Nothing
End Function
答案 0 :(得分:2)
您可以使用记录集的字段集合进行比较和复制:
Option Compare Database
Option Explicit
Public Function update1()
'Temp field
Dim fField As Field
Dim bCopy As Boolean
'Open source database
Dim dSource As Database
Set dSource = CurrentDb
'Open dest database
Dim dDest As Database
Set dDest = DAO.OpenDatabase("C:\Users\simon\Documents\SellerDeck 2013\Sites\dest\ActinicCatalog.mdb")
'Open source recordset
Dim rSource As Recordset
Set rSource = dSource.OpenRecordset("Address", dbOpenForwardOnly)
'Open dest recordset
Dim rDest As Recordset
Set rDest = dDest.OpenRecordset("Address", dbOpenDynaset)
'Loop through source recordset
While Not rSource.EOF
'Reset copy flag
bCopy = False
'Look for record in dest recordset
rDest.FindFirst "nCustomerID = " & rSource.Fields("nCustomerID") & ""
If rDest.NoMatch Then
'If not found, copy record
rDest.AddNew
bCopy = True
Else
'If found, check for differences
For Each fField In rSource.Fields
If rDest.Fields(fField.Name) <> rSource.Fields(fField.Name) Then
rDest.Edit
bCopy = True
Exit For
End If
Next fField
Set fField = Nothing
End If
'If copy flag is set, copy record - ignore errors
If bCopy Then
For Each fField In rSource.Fields
If Not (fField.Attributes And dbAutoIncrField) Then
On Error Resume Next
rDest.Fields(fField.Name) = rSource.Fields(fField.Name)
On Error Goto 0
End If
Next fField
Set fField = Nothing
rDest.Update
End If
'Next source record
rSource.MoveNext
Wend
'Close dest recordset
rDest.Close
Set rDest = Nothing
'Close source recordset
rSource.Close
Set rSource = Nothing
'Close dest database
dDest.Close
Set dDest = Nothing
'Close source database
dSource.Close
Set dSource = Nothing
End Function
答案 1 :(得分:1)
据我了解,您问题的一个简单模型是:
给出表格
SELECT * FROM CustA
-------------------
|Id|Nme |
| 2|A. Only |
| 6|A. B. Same|
|12|A. B. New |
-------------------
和
SELECT * FROM CustB
---------------------
|Id|Nme |
| 3|B. Only |
| 6|A. B. Same|
|12|A. B. Old |
---------------------
我的主张是:客户单独或两者中的A(2)或B(3),则数据相同(6)或不同(12);没有其他可能性。
如果您将(2)复制到B并更新(12),您将获得:
SELECT * FROM CustC
----------------------
|Id|Nme |
| 2|A. Only |
| 6|A. B. Same|
|12|A. B. New |
| 3|B. Only |
----------------------
这可以通过简单的SQL语句在没有任何花哨/错误倾向/表特定循环的情况下完成:
(1)将CustA复制到CustC
SELECT * Into CustC FROM CustA
(2)获得那些B只记录
INSERT Into CustC SELECT B.*
FROM CustB B LEFT JOIN CustA A On A.Id = B.Id
WHERE A.Id Is Null