Access　VBA　SQLで抽出した値をフォームに入れたい

こんにちは質問させていただきます。

フォームに3連コンボボックスを作成しました。（以下の画像です）

この３連コンボボックスで製品を
製品大分類
製品名
製品型番
といった形で
最終的に製品型番を求めるために使用します。

そして、その製品型番に紐づいている製品コードを求めたいと思っています。

求めたらフォームの「製品コード」テキストボックスに
自動入力したいと思っています。

理由としては、「製品コード」テキストボックスに製品コードを入力すると
リレーションシップを組んでいるので
単価
個数
etc...
が自動入力されるからです。

それを実現させるために、以下のコードを書いているのですが
思った挙動になりません。

「このフィールドを変更する前に、まずレコードを保存してください。」
といったエラーが出ます。

VBA
1Private Sub 製品型番_AfterUpdate()
2Dim cn As ADODB.Connection    'Connectionオブジェクト
3Dim rs As ADODB.Recordset     'Recordsetオブジェクト
4Dim mySQL As String           'SQLステートメント
5
6
7'接続
8Set cn = CurrentProject.Connection
9
10'レコードセットを取得
11Set rs = New ADODB.Recordset
12mySQL = "SELECT * FROM 製品マスタ " _
13& "WHERE 製品型番 = '" & Me!製品型番 & "'"
14
15rs.Open mySQL, cn, adOpenKeyset, adLockOptimistic
16'確認
17If rs.Supports(adUodate) Then
18MsgBox ("編集可能です")
19Else
20MsgBox ("編集できません")
21End If
22
23Do Until rs.EOF
24
25Me!製品コード = rs!製品コード
26rs.MoveNext
27Loop
28
29
30
31'終了
32
33rs.Close: Set rs = Nothing
34cn.Close: Set cn = Nothing
35End Sub

補足資料です

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

行動規範の内容に同意します

回答1件

ベストアンサー

フォームの画像をみると連結フォームですね。
連結フォームは、フォームを開くと自動でたテーブル（またはクエリ）が開かれて、そのレコードセットがフォーム上に表示されています。
レコードの更新はそのフォーム上で簡単にできます。

rs.Open で別にレコードセットを開いてそこでデータ操作する必要はありません。
rs.Open のようなコードを使うのは、かなりのスキルを持った開発者がAccessの基本機能ではできない高度なことをするときに使うものなので、まずは、基本機能を理解しましょう。

今回のように、
製品マスタから対応するコードを参照するなら、DLookup関数で可能です。

vba
1Private Sub 製品型番_AfterUpdate()
2    Dim strWhere As String    
3    strWhere = "製品大分類='" & Me.製品大分類 & "'" & _
4               " AND 製品名='" & Me.製品名 & "'" & _
5               " AND 製品型番='" & Me.製品型番 & "'"
6
7    Me!製品コード = DLookup("製品コード", "製品マスタ", strFilter)  
8
9End Sub

投稿2021/09/11 06:10

編集2021/09/11 07:45

hatena19

総合スコア33715

sugawa

2021/09/11 06:30

hatena19様ありがとうございます！ただいま試してみました！何が悪いのかわからないのですが構文エラーが出てしまいました。エラー的にはコンパイルエラー：修正候補：ステートメントの最後というエラーが出ます。すみませんが質問させてくださいよろしくお願いいたします。

hatena19

2021/09/11 07:46

回答のコードの間違いを修正しましたので、そちらでもう一度試してみてください。

sugawa

2021/09/11 10:30

hatena19様ありがとうございます！何回もすみません。修正いただいたコードで試してみたのですがまだエラーが出てしまいます。実行時エラー’3331’：このフィールドを変更する前に、まずレコードを保存してください。といったエラーが出ます。すみませんが質問させてくださいよろしくお願いいたします。

sugawa

2021/09/11 11:32

hatena19様お世話になっております。以下のように修正してみました。 ```VBA Private Sub 製品型番_AfterUpdate() Dim strWhere As String strWhere = "製品大分類='" & Me.製品大分類 & "'" & _ " AND 製品名='" & Me.製品名 & "'" & _ " AND 製品型番='" & Me.製品型番 & "'" Me!製品コード = DLookup("製品コード", "製品マスタ", strWhere) End Sub ``` また、フォーム全体はレコードソースを Q_入出庫データで３連コンボボックスは製品マスタを値集合ソースに使っていたので何か不具合があったのではないかと思います詳細は分かりませんが、同じレコードソース同士でないと VBAの制御が効かなかったのかなと思いましたがどうでしょうか？ hatena19様よろしくお願いいたします

hatena19

2021/09/11 13:52

フォーム上の他のイベントで rs.Open していませんか。もし、あるなら、そのコードを削除してください。あと、手入力で、製品コードを入力した場合、どうなりますか。製品マスターを値集合ソースに使うことは問題ないです。値集合ソースは参照するだけで更新しないので。

sugawa

2021/09/11 17:58

hatena19様お世話になっております。フォーム上の他のイベントで rs.Openはしていません。また、手入力すると製品大分類製品名製品型番単価個数までが自動入力される状態です。よろしくお願いいたします。

hatena19

2021/09/12 05:22

「このフィールドを変更する前に、まずレコードを保存してください。」というエラーはどのタイミングででますか。また、エラーで出るのはどのコードですか。

sugawa

2021/09/12 06:09

hatena19様ありがとうございます。エラーが出るタイミングは３連コンボボックスで製品大分類製品名製品番号と順番に選択して入力しているとき最後の製品型番を選択し終わったときに出ますエラーで出るコードは Me!製品コード = DLookup("製品コード", "製品マスタ", strWhere) になります。よろしくお願いいたします。

hatena19

2021/09/12 06:16

エラーの出るコードを下記に書き換えてから、製品番号を請託したときにメッセージボックスに該当する製品コードは表示されますか。 MsgBox DLookup("製品コード", "製品マスタ", strFilter)

sugawa

2021/09/12 06:33

hatena19様ありがとうございます。メッセージボックスには製品コードは表示されます

行動規範の内容に同意します