AccessVBAのRecordsetについて

Question

AccessVBAを学んでおります。
その中で

recordsetした値Aとrecordsetした値Bを比較して
一致すれば上書き、なければ新規追加という処理を考えました。
以下のコードです。

Private Sub newAndUpdate_Click()

    '値があれば比較、なければ更新をかける
    Dim con As New ADODB.Connection
    
    Dim strSQL As String
    strSQL = "SELECT * FROM USD_JPY "
    
    Dim adoRS1 As ADODB.Recordset
    Set adoRS1 = New ADODB.Recordset
    
    
    'testDBに入っている元データをレコードセットする
    adoRS1.Open strSQL, CurrentProject.Connection, _
                        adOpenDynamic, adLockOptimistic
    
    '外部データベースに接続してレコードセットする
    con.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source = C:\Users\user\Documents\FXDATA.accdb"
    
    Dim adoRS2 As ADODB.Recordset
    Set adoRS2 = New ADODB.Recordset
    adoRS2.Open "ドル円", con, adOpenDynamic, adLockOptimistic
    
    'adoRS1でレコードセットした値を別のテーブルに代入する
    Do Until adoRS1.EOF
        adoRS2.MoveFirst
        Do Until adoRS2.EOF
            If adoRS1("日付け") <> adoRS2("日付け") Then
            
            Debug.Print adoRS1("日付け")
            Debug.Print adoRS2("日付け")
            strSQL = "INSERT INTO ドル円(日付け,終値,始値,高値,安値,[前日比%]) " & _
             "IN 'C:\Users\user\Documents\FXDATA.accdb' " & _
             "VALUES('" & adoRS1("日付け") & "','" & adoRS1("終値") & "'," & _
             "'" & adoRS1("始値") & "','" & adoRS1("高値") & "'," & _
             "'" & adoRS1("安値") & "','" & adoRS1("前日比%") & "') "

            Else
            Debug.Print adoRS1("日付け")
            
            
            strSQL = "UPDATE ドル円 " & _
                     "IN 'C:\Users\user\Documents\FXDATA.accdb' " & _
                     "SET 日付け = '" & adoRS1("日付け") & "'," & _
                     "終値 = '" & adoRS1("終値") & "'," & _
                     "始値 = '" & adoRS1("始値") & "'," & _
                     "高値 = '" & adoRS1("高値") & "'," & _
                     "安値 = '" & adoRS1("安値") & "'," & _
                     "[前日比%] = '" & adoRS1("前日比%") & "' "
            
            adoRS2.MoveNext
            Exit Do
            End If
            adoRS2.MoveNext
            
        Loop

        CurrentDb.Execute strSQL
        
        adoRS1.MoveNext
    Loop

End Sub

２重のループを考えたのですが、問題は
・adoRS2.MoveNextというものを書いたのですが、
adoRS2の方だけrecordが次へ送られない状態になりまして困っております。
adoRS1の方は普通に次のレコードに移動している。

試したこと
・デバッグでF8を押しながら一行ずつ確認、adoRS2.MoveNext行を通過後
イミディエイトウィンドウにて[?adoRS2("日付け")]と確認するも値の変更なし
・IF文の中にadoRS2.MoveNextを書いても値の変化無し、IFの外に書いても値の変化無し。

この原因についてお分かりになる方いらっしゃいましたら、ご教示願います。

よろしくお願いいたします。

【追記】
こちらのサイトからダウンロードしたデータをそのまま使用しております。
https://jp.investing.com/currencies/usd-jpy-historical-data

テーブル構造とデータはこのようになっており、日付けを起点にデータを比較して
更新分があれば上書き、なければ追加という処理を書きたいと考えております。

Answer 1

テーブル同士の比較は通常SQLでキーによる結合を行います。
FXDATA.accdb内のVBAで実行するなら、CurrentDbでの実行すればよいだけです。

以下はSQLの実行をVBA内で行う場合です。
但し、それぞれのテーブルで[日付け]が一意キーである前提。
先ず、[日付け]が同じもの同士を更新。
次に、USD_JPYの[日付け]がドル円にないものを追加

Private Sub newAndUpdate_Click()

    Dim strSQL As String

    DoCmd.SetWarnings False   '更新確認のメッセージをOFFにする

    strSQL = ""
    strSQL = strSQL & "UPDATE ドル円 INNER JOIN USD_JPY ON ドル円.日付け=USD_JPY.日付け SET"
    strSQL = strSQL & vbCrLf & " ドル円.終値=USD_JPY.終値"
    strSQL = strSQL & vbCrLf & ",ドル円.始値=USD_JPY.始値"
    strSQL = strSQL & vbCrLf & ",ドル円.高値=USD_JPY.高値"
    strSQL = strSQL & vbCrLf & ",ドル円.安値=USD_JPY.安値"
    strSQL = strSQL & vbCrLf & ",ドル円.[前日比%]=USD_JPY.[前日比%]"
    CurrentDb.Execute strSQL

    strSQL = ""
    strSQL = strSQL & "INSERT INTO ドル円("
    strSQL = strSQL & vbCrLf & "  日付け, 終値, 始値, 高値, 安値, [前日比%]"
    strSQL = strSQL & vbCrLf & ")"
    strSQL = strSQL & vbCrLf & "SELECT 日付け, 終値, 始値, 高値, 安値, [前日比%]"
    strSQL = strSQL & vbCrLf & "FROM USD_JPY LEFT JOIN ドル円"
    strSQL = strSQL & vbCrLf & "     ON USD_JPY.日付け=ドル円.日付け"
    strSQL = strSQL & vbCrLf & "WHERE ドル円.日付け Is Null"
    CurrentDb.Execute strSQL

    DoCmd.SetWarnings True    '更新確認のメッセージをONにする

End Sub

レコードセットで処理したいなら、テーブルを結合したselectのレコードセットを元にする、という方法もあります。

どうしても2つのレコードセットで行いたいなら、全件纏めて処理する際の条件がありませんから上書きされたりしていますね。

Find メソッドを使用して、同じ日付のデータに揃えて下さい。

adoRS2の方だけrecordが次へ送られない状態になりまして困っております。

adoRS2のデータに追加を行っているからだと思います。

adOpenDynamicではなく、adOpenStaticで更新の影響を受けないようにしてみてはどうでしょうか。

adoRS2.Open "ドル円", con, adOpenStatic

Comments

[ataru2222]

sazi様
返信ありがとうございます。

SQLで書くとこんな書き方になるのですね。
まだ４月からSQLを勉強して間もないのでとても参考になります。

今回はレコードセットしてaccessVBA上で比較更新の際のrecordsetのMoveNextで値が次へ渡せない状況の原因を探っております。なにかヒントがありましたらご教示いただきたいです。
よろしくお願いいたします。

[ataru2222]

sazi様
追記ありがとうございます。

adOpenDynamicではなく、adOpenStaticで更新の影響を受けないようにしてみてはどうでしょうか。

この記述について、何気なく(理解せず)使ってしまっておりました。
ひとつひとつの意味を理解して使っていこうと思います。
教えていただきまして、本当にありがとうございます。

[hatena19]

Recordset.FindFirst メソッド は DAOのメソッドです。ADOは Find メソッド になりますね。
Find メソッド-ActiveX データオブジェクト (ADO) | Microsoft Docs
https://docs.microsoft.com/ja-jp/office/client-developer/access/desktop-database-reference/find-method-ado

[sazi]

@hatena19さん
フォローありがとうございます。

Answer 2

現状は、レコードセットを使いながら、追加、更新はSQLというハイブリッドな手法ですので複雑になってます（このようなハイブリッドはメリットはないです）。

レコードセットを使って操作するなら、レコードセットのメソッドを使うようすべきです。

SQLを使うなら、saziさんの回答のような方法で一気にするのがいいでしょう。

レコードセットでの追加はAddNewメソッド~~、更新はEditメソッド~~を使います。代入後、Updateメソッドで更新します。

下記のようなコードになります。

    Do Until adoRS1.EOF
        With adoRS2
            .MoveFirst
            .Find "日付け = #" & adoRS1!日付け.Value  & "#", 0, adSearchForward
            If adoRS2.EOF Then '同じ日付けのレコードがなければ新規追加
                .AddNew
                !日付け.Value = adoRS1!日付け.Value
            End If
            !終値.Value = adoRS1!終値.Value
            !始値.Value = adoRS1!始値.Value
            !高値.Value = adoRS1!高値.Value
            !安値.Value = adoRS1!安値.Value
            .Update
        End with
        adoRS1.MoveNext
   Loop

検索(Findメソッド)すれば adoRS2.MoveNext は不要。また、検索の方が高速。

・デバッグでF8を押しながら一行ずつ確認、adoRS2.MoveNext行を通過後

イミディエイトウィンドウにて[?adoRS2("日付け")]と確認するも値の変更なし
・IF文の中にadoRS2.MoveNextを書いても値の変化無し、IFの外に書いても値の変化無し。

この原因についてお分かりになる方いらっしゃいましたら、ご教示願います。

これに関しては、SQL の Update文に抽出条件がないので、すべてのレコードを更新してしまってます。それによってすべてのレコードの日付が同じになってしまいますので、レコード移動しても日付は同じになるというこかと推測します。

Comments

[imihito]

Recordsetは両方ともADODB.Recordsetのようなので、Findメソッドで見つかった場合のEditメソッドは不要ではないでしょうか？

[hatena19]

あっ、そうですね。DAOと混同してました。ご指摘ありがとうございます。
回答、修正しておきます。

[ataru2222]

返信ありがとうございます。
まさに「SQL の Update文に抽出条件がないので、すべてのレコードを更新してしまってます。」
この状態になっておりました。

strSQL = "UPDATE ドル円 " & _
"IN 'C:\Users\user\Documents\FXDATA.accdb' " & _
"SET 日付け = '" & adoRS1("日付け") & "'," & _
"終値 = '" & adoRS1("終値") & "'," & _
"始値 = '" & adoRS1("始値") & "'," & _
"高値 = '" & adoRS1("高値") & "'," & _
"安値 = '" & adoRS1("安値") & "'," & _
"[前日比%] = '" & adoRS1("前日比%") & "' " & _
"WHERE '" & adoRS1("日付け") & "'='" & adoRS2("日付け") & "'"

いろいろ試す中で、SQLのUPDATEの条件文にWHERE句で抽出条件を入れてみたのですが、全件更新してしまいます。このような場合はどうやって書けば良いでしょうか？

本来このような書き方はしないという事を勉強させていただきましたが、ここまで粘ったので、こういう書き方もできるという勉強のためにハイブリットなやり方も使えるようになっておきたいです。
よろしくお願いいたします。回答して頂きまして、本当にありがとうございます。

[sazi]

SQL文もdebugで出力して確認すると理由が分かると思います。

[ataru2222]

sazi様

デバッグ機能でSQL文のデバッグもできるのですね。まだAccess自体が浅いのでいろいろ調べて試してみます。
ありがとうございます。

[hatena19]

"WHERE '" & adoRS1("日付け") & "'='" & adoRS2("日付け") & "'"
の部分ですが、抽出条件は　対象フィール名=検索値 という式にしなければなりません。
上記の式だと　値=値 になってますので、常にTrueか常にFalseのどちらかになります。つまり全件対象か対象無しになります。
"WHERE 日付け='" & adoRS1("日付け") & "'"
とすべきです。
また、上記の式だと「日付け」はテキスト型ということになります。日付/時刻型の場合は、
"WHERE 日付け=#" & adoRS1("日付け") & "#"
とすべきです。

さらに、レコードセットは ADO ですが、SQL実行の
CurrentDb.Execute strSQL
はDAOになってます。ADOとDAOのハイブリットもトラブルの元ですので、どちらかに統一すべきです。
ADOなら、
CurrentProject.Connection.Execute strSQL
とします。

さらに、さらに、２重ループのロジックもおかしいと思いますので、見直す必要があるでしょう。

自動車のハイブリットは低燃費というメリットがありますが、このようなハイブリッドはメリットは何ひとつなくデメリットは多々あります。
まずは、基本のADO の AddNewメソッド、Updateメソッドでの追加/更新、あるいは、SQLで一気に追加更新する方法を理解、習得するのが先決ではないでしょうか。

それが理解できてから、ハイブリッドに挑戦してみてください。上記の方法が習得できているなら、このハイブリットの無意味さが理解できると思います。

[sazi]

ハイブリッドは良いとこ取りとして良い意味しかありませんので、やってみようと思われるかもしれませんね。
単に不統一と表現した方が諦めがつくかも。

[hatena19]

確かにそうですね。カッコつけてしまいました（反省）

[ataru2222]

hatena19様
sazi様

やりたい事ができました。
理解できてなかった細かい部分を教えてくださり本当にありがとうございます。

SQLもAccessVBAもまだまだ未熟なので、どちらも対応できるようしっかり記録に残して日々精進していきます。本当にありがとうございました。

Answer 3

回答ではないです。

コードを検証したく、少し検証したのですが、想像力がなくて断念しました。

上級者の方に検証していただくためには

各テーブルの情報のサンプルを提示していただくといいかもしれません。。

Comments

[ataru2222]

ymakoto様
返信ありがとうございます。
https://jp.investing.com/currencies/usd-jpy-historical-data

このサイト中央部あたりのダウンロードから、データを取込み、古いデータとのデータを比較しての重複しないようなデータを登録するというものが作りたいと思っております。
このサイトでデータの絞込みができるので、実際はこういう事は必要ないのですが、業務で使うSQLとaccessVBAの勉強のために使用しております。ちょっと前にもrecordsetした値をMoveNextできないという現象が起きていたので、自分が書く構文に問題があると感じております。

原因を突き止めたいです。

[退会済みユーザー]

上級者の方のご助言にある通りだと思いますが、サンプルをご提示いただきましたので
出来ない可能性もありますが
本日から明日・夕方～夜間みさせていただければと思っています。

[ataru2222]

ymakoto様
ありがとうございます(涙)
よろしくお願いいたします。

[退会済みユーザー]

おはようございます。
出来たようですね。
朝から検証していたのですが、やはり更新すると重複したりしますね。

皆さんがおっしゃっている通り、重複チェックを行うロジックがないと
新規でどんどんデータが増えていってしまうためループ処理だけではうまくいかないようです。

お力になれず申し訳ありません。

[ataru2222]

ymakoto様
検証していただきましてありがとうございます(涙)
レコードセットのMoveNextの問題もUPDATEのWHERE句ないことで全件更新してしまっていることが問題だとわかり、納得することができました。
ADOでもSQLでもこのような書き方はしないということが勉強になりました。
こちらのプログラムでいちおは動くと思います。
２重ループのあたりがおかしいとの指摘を頂いておりますが・・・。

Private Sub newAndUpdate_Click()

'値があれば比較、なければ更新をかける
Dim con As New ADODB.Connection

Dim strSQL As String
strSQL = "SELECT * FROM USD_JPY "

Dim adoRS1 As ADODB.Recordset
Set adoRS1 = New ADODB.Recordset

'testDBに入っている元データをレコードセットする
adoRS1.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic

'外部データベースに接続してレコードセットする
con.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source = C:\Users\user\Documents\FXDATA.accdb"

Dim adoRS2 As ADODB.Recordset
Set adoRS2 = New ADODB.Recordset
adoRS2.Open "ドル円", con, adOpenStatic

'adoRS1でレコードセットした値を別のテーブルに代入する
Do Until adoRS1.EOF
adoRS2.MoveFirst
Do Until adoRS2.EOF
If adoRS1("日付け") <> adoRS2("日付け") Then

Debug.Print adoRS1("日付け")
Debug.Print adoRS2("日付け")
strSQL = "INSERT INTO ドル円(日付け,終値,始値,高値,安値,[前日比%]) " & _
"IN 'C:\Users\user\Documents\FXDATA.accdb' " & _
"VALUES('" & adoRS1("日付け") & "','" & adoRS1("終値") & "'," & _
"'" & adoRS1("始値") & "','" & adoRS1("高値") & "'," & _
"'" & adoRS1("安値") & "','" & adoRS1("前日比%") & "') "

Else
Debug.Print adoRS1("日付け")

strSQL = "UPDATE ドル円 " & _
"IN 'C:\Users\user\Documents\FXDATA.accdb' " & _
"SET 日付け = '" & adoRS1("日付け") & "'," & _
"終値 = '" & adoRS1("終値") & "'," & _
"始値 = '" & adoRS1("始値") & "'," & _
"高値 = '" & adoRS1("高値") & "'," & _
"安値 = '" & adoRS1("安値") & "'," & _
"[前日比%] = '" & adoRS1("前日比%") & "' " & _
"WHERE 日付け = #" & adoRS1("日付け") & "#"

adoRS2.MoveNext
Exit Do
End If
adoRS2.MoveNext

Loop

CurrentDb.Execute strSQL

adoRS1.MoveNext
Loop

End Sub

時間を割いて、わたくしなどに付き合っていただき、
本当にありがとうございます。
日々勉強して精進していきます。