0

あるデータベースから別のデータベースに約 10 の異なるテーブル内の値を移動するマクロを既に作成しました。列「nid」などの一意の識別子を取り、それが新しいデータベースに既に存在するかどうかを確認し、一致がない場合はデータを移動し、一致する場合はデータを移動します。

このマクロは正常に動作していますが、値が既に存在するかどうか、各列に変更がないかどうかを確認し、値に変更があるかどうかを確認して、新しい値を移動します。たとえば、元のデータベースでパスワードを変更すると、新しいデータベースで更新されます。

一部のテーブルには最大 50 の列があるため、それぞれを手動でループすると非常に長いマクロになります。これを行う簡単な方法があるかどうか疑問に思っていました。そうでない場合、どうすればそれらをループできますか?

1つのテーブルのマクロは次のとおりです。

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
4

2 に答える 2

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
于 2013-07-18T08:14:10.127 に答える
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
于 2013-07-18T10:34:12.903 に答える