2019.08.15

Access SQL VBA 練習問題

【Access VBA】実践演習 #5 (貸出・返却機能の実装)

このシリーズでは書籍管理システムの作成を通して、Access VBAの使い方を学ぶことを目標とします。
データベース操作はDAOを使って実装します。
Accessの基本的な操作は知っているけれど、VBAはあまり書いたことがない方を対象としています。

途中SQLも使いますので、不安な方はこちらの記事等で確認してください。
⇒ AccessでSQLの練習

必要なファイルのダウンロードやテーブル等の確認は初回の記事をご覧ください。
⇒ 【Access VBA】実践演習 #1

今回は「F_貸出登録」「F_返却登録」「F_貸出履歴」の各機能を実装していきたいと思います。

■練習5-1 (貸出登録ボタン)

「F_貸出登録」の「貸出登録」ボタンをクリック時に、以下の処理を行うようにしてください。
1.「蔵書一覧」テーブルの対象の書籍の貸出状況を「貸出中」に変更する。
2.「貸出履歴」テーブルに新規レコードを追加する。(返却日は空で良い。)

(追加要件)
・貸出状況が「貸出中」の場合はエラーメッセージを表示する。
・ユーザーIDや貸出日が空の時にはエラーメッセージを表示する。
・貸出登録の前には確認メッセージを表示する。
・登録が完了したら「F_貸出履歴」を開く。（閉じて開く）

・「F_貸出登録」以下の状態でボタンクリック

・「蔵書一覧」テーブル

・「貸出履歴」テーブル

解答例・解説
今回も2パターン紹介します。

①レコードセットを使う

解答例は以下になります。
[vb] Private Sub 貸出登録ボタン_Click()

‘ 貸出状況のチェック
If Me.貸出状況 = "貸出中" Then
MsgBox "貸出中の書籍です。", vbCritical, "貸出失敗"
Exit Sub
End If

‘ 入力チェック
If IsNull(Me!USER_ID) Then
MsgBox "ユーザーを選択してください。", vbExclamation
Exit Sub
End If

If IsNull(Me!貸出日) Then
MsgBox "貸出日を入力してください。", vbExclamation
Exit Sub
End If

‘ 貸出確認メッセージ
Dim msg As String
msg = "■貸出登録を行います。" & vbCrLf & _
"タイトル：" & タイトル & vbCrLf & _
"ユーザー：" & Me.USER_ID.Column(1) & vbCrLf & _
"貸出日：" & Me!貸出日

If MsgBox(msg, vbOKCancel) <> vbOK Then
Exit Sub
End If

‘ 貸出処理
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset

Set db = CurrentDb()

Set rs1 = db.OpenRecordset("蔵書一覧", dbOpenDynaset)
Set rs2 = db.OpenRecordset("貸出履歴", dbOpenDynaset)

‘ 「蔵書一覧」の貸出状況を「貸出中」に変更
rs1.FindFirst ("BOOK_ID=" & Me.BOOK_ID)
rs1.Edit
rs1.Fields("貸出状況") = "貸出中"
rs1.Update

‘ 「貸出履歴」にレコードを追加
rs2.AddNew
rs2.Fields("BOOK_ID") = Me.BOOK_ID
rs2.Fields("USER_ID") = Me.USER_ID.Column(0)
rs2.Fields("貸出日") = Me.貸出日
rs2.Update

‘ Closeの処理
rs1.Close
rs2.Close
db.Close

‘ 「F_貸出履歴」開く
DoCmd.Close acForm, "F_貸出履歴"
DoCmd.OpenForm "F_貸出履歴"

MsgBox "貸出登録が完了しました。", vbInformation

End Sub
[/vb] やや長めのコードですが、内容としては既出の処理の組み合わせとなります。
コメントを付けているので追ってみて下さい。
新しいこととしては、一つのイベントで２つのテーブルを操作していることですが、
その場合はレコードセット用の変数を２つ(rs1とrs2)用意します。

②SQLを使う

解答例は以下になります。
[vb] Private Sub 貸出登録ボタン_Click()

‘ 貸出状況のチェック
If Me.貸出状況 = "貸出中" Then
MsgBox "貸出中の書籍です。", vbCritical, "貸出失敗"
Exit Sub
End If

‘ 入力チェック
If IsNull(Me!USER_ID) Then
MsgBox "ユーザーを選択してください。", vbExclamation
Exit Sub
End If

If IsNull(Me!貸出日) Then
MsgBox "貸出日を入力してください。", vbExclamation
Exit Sub
End If

If MsgBox(msg, vbOKCancel) <> vbOK Then
Exit Sub
End If

‘ 貸出処理
Dim db As DAO.Database
Dim sql1 As String
Dim sql2 As String

Set db = CurrentDb()

‘ 「蔵書一覧」の貸出状況を「貸出中」に変更するSQL
sql1 = "UPDATE 蔵書一覧 SET 貸出状況=’貸出中’ WHERE BOOK_ID = " & Me!BOOK_ID

‘ 「貸出履歴」にレコードを追加するSQL
sql2 = "INSERT INTO 貸出履歴 (BOOK_ID,USER_ID,貸出日) VALUES (" & Me!BOOK_ID & "," & Me!USER_ID.Column(0) & ",’" & Me!貸出日 & "’)"

‘ SQL実行
db.Execute sql1
db.Execute sql2

‘ Closeの処理
db.Close

‘ 「F_貸出履歴」開く
DoCmd.Close acForm, "F_貸出履歴"
DoCmd.OpenForm "F_貸出履歴"

MsgBox "貸出登録が完了しました。", vbInformation

End Sub
[/vb] 毎度のことですがSQLがややこしいです。(特にInsert)
それぞれ作成したいのは以下のようなSQLです。
・SQL1(蔵書一覧テーブルの貸出状況を貸出中にする)
[sql] UPDATE 蔵書一覧 SET 貸出状況=’貸出中’ WHERE BOOK_ID = 2
[/sql]

・SQL2(貸出履歴テーブルにレコード追加)
[sql] INSERT INTO 貸出履歴 (BOOK_ID,USER_ID,貸出日) VALUES (2,2,’2019/08/15′)
[/sql]

■練習5-2 (返却ボタン)

「F_貸出履歴」の「返却」ボタンをクリックした際に、「F_返却登録」を開くようにしましょう。
ただし、対象の書籍(貸出ID)のフォームが開くようにフィルターをかけてください。
また、返却済み書籍の場合にはエラーメッセージを表示してください。(返却日が空でない書籍)

・返却済みの場合エラーメッセージ

・未返却の書籍の「返却」ボタンクリック

(ヒント)
・フィルターはDoCmd.OpenFormの第4引数で指定可能。
・「F_返却登録」のレコードソースは「Q_貸出中書籍」です。IDカラムは「貸出履歴」テーブルのIDカラム。

解答例・解説

解答例は以下です。
[vb] Private Sub 返却ボタン_Click()
If IsNull(Me.返却日) Then
DoCmd.OpenForm "F_返却登録", acNormal, "", "ID=" & Me.ID
Else
MsgBox "返却済みの書籍です", vbExclamation
End If
End Sub
[/vb]

これも基本的には既出の内容となります。
OpenFormするときのフィルターとしては対象カラム名を「ID」にしていて、
これは「F_返却登録」のレコードソースである「Q_貸出中書籍」の「IDカラム」を指しています。
値に渡している「Me.ID」が「F_貸出履歴」における「貸出ID」列のコントロールを指します。(以下画像)

■練習5-3 (返却登録ボタン)

「F_返却登録」の「返却登録」ボタンをクリック時に、以下の処理を行うようにしてください。
1.「蔵書一覧」テーブルの対象の書籍の貸出状況を「貸出可」に変更する。
2.「貸出履歴」テーブルの対象のIDのレコードの返却日にフォームの日付を入力する。

(追加要件)
・返却日が空の場合はエラーメッセージを表示する。
・登録が完了したら「F_貸出履歴」を開く。（開く前に「F_返却登録」を閉じる）

解答例・解説
今回も2パターン紹介します。

①レコードセットを使う

解答例は以下になります。
[vb] Private Sub 返却登録ボタン_Click()

‘ 入力チェック
If IsNull(Me.返却日) Then
MsgBox "返却日を入力してください。", vbCritical, "返却失敗"
Exit Sub
End If

‘ 返却処理
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset

Set db = CurrentDb()

Set rs1 = db.OpenRecordset("蔵書一覧", dbOpenDynaset)
Set rs2 = db.OpenRecordset("貸出履歴", dbOpenDynaset)

‘ 「蔵書一覧」テーブルの貸出状況を「貸出可」に変更
rs1.FindFirst ("BOOK_ID=" & Me.BOOK_ID)
rs1.Edit
rs1.Fields("貸出状況") = "貸出可"
rs1.Update

‘ 「貸出履歴」テーブルの返却日にフォームの日付を入力する
rs2.FindFirst ("ID=" & Me.ID)
rs2.Edit
rs2.Fields("返却日") = Me.返却日
rs2.Update

‘ レコードセットとデータベースを閉じる
rs1.Close
rs2.Close
db.Close

‘ 「F_貸出履歴」を開く(「F_返却登録」は閉じる)
DoCmd.Close acForm, "F_返却登録"
DoCmd.OpenForm "F_貸出履歴"

MsgBox "返却が完了しました", vbInformation

End Sub
[/vb]

練習5-1とほとんど同じですが、違いとしては「貸出履歴」テーブルに対する処理が
登録(Insert)ではなく更新(Update)になっているところになります。

②SQLを使う

解答例は以下になります。
[vb] Private Sub 返却登録ボタン_Click()

‘ 入力チェック
If IsNull(Me.返却日) Then
MsgBox "返却日を入力してください。", vbCritical, "返却失敗"
Exit Sub
End If

‘ 返却処理
Dim db As DAO.Database
Dim sql1 As String
Dim sql2 As String

Set db = CurrentDb()

‘ 「蔵書一覧」の貸出状況を「貸出可」に変更するSQL
sql1 = "UPDATE 蔵書一覧 SET 貸出状況=’貸出可’ WHERE BOOK_ID = " & Me!BOOK_ID

‘ 「貸出履歴」の返却日を登録するSQL
sql2 = "UPDATE 貸出履歴 SET 返却日=’" & Me!返却日 & "’ WHERE ID = " & Me!ID

‘ SQL実行
db.Execute sql1
db.Execute sql2

‘ Closeの処理
db.Close

‘ 「F_貸出履歴」を開く(「F_返却登録」は閉じる)
DoCmd.Close acForm, "F_返却登録"
DoCmd.OpenForm "F_貸出履歴"

MsgBox "返却が完了しました", vbInformation

End Sub
[/vb] これもやはり練習5-1と同様で、InsertがUpdateになっているところだけ異なっています。
念のため、各SQLは以下の通りです。
・「蔵書一覧」の貸出状況を「貸出中」に変更するSQL
[sql] UPDATE 蔵書一覧 SET 貸出状況=’貸出可’ WHERE BOOK_ID = 1
[/sql] ・「貸出履歴」の返却日を登録するSQL
[sql] UPDATE 貸出履歴 SET 返却日=’2019/08/15′ WHERE ID = 8
[/sql]

以上、書籍管理システムの作成を通して、AccessVBAでよく使うデータベース操作を見てきました。
5回の記事で作成したプログラムが理解できて使いこなせていれば、ほとんどの要件には対応できるかと思います。

説明の都合上テーブルやフォームは事前に用意しましたが、
プログラムやSQLに慣れてきた方は0からテーブルの設計、フォームの設計を行い、
ご自身で同じようなシステム、より良いシステムが作成できるのが理想かと思います。

では、お疲れ様でした！