後輩君が何やら頭を抱えて悩んでいたので聞いてみた。
「現在とある業務で使用してるAccessのテーブル「A」と「B」と「C」は正規化の観点からするとひとつのテーブルに集約することができるが、フィールド数が多くなることと、業務の流れとして「A」が確定してから「B」と「C」を入力するということであえて分割してある。現在、それぞれのテーブルを更新・削除を行う場合、個別のフォームを用いているが、作業量が増えてきた関係で煩わしくなってきた。更新・削除を1つのフォームから行うことはできないだろうか？」
…というのが悩みの種のようです。ちなみに後輩君のレベルは簡単なクエリとそれに基づいたフォームが作れるくらいです。確かにちょっと悩んじゃうかもしれません。個人的には追加部分を工夫するとして正規化しちゃえばいいじゃんってとこですが、まぁ、そうできないケースも今後発生するかもしれないのでとりあえずこのまま挑戦させてみようかなぁってことで、このブログでは後輩君をほっておいて自分的な考察やらコードをあげちゃいます。聞くだけ聞いてなんなんですが後輩君には自分で考えてもらいます。
とりあえずサンプルデータです。「A」「B」「C」のテーブルは「A」を基点としてそれぞれ1対1で連結しています（フィールド数が少ないことは気にしない）。
| A | | | B | | | | C | | | |
| Id | AName | | Id | AId | BName | | Id | AId | CName | |
| 1 | 太郎 | | 1 | 1 | 犬 | | 1 | 1 | オス | |
| 2 | 花子 | | 2 | 2 | 猫 | | 2 | 2 | メス | |
| | | | | | | | | | | |
次に根本的な考え方ですが、フォームとテーブル（クエリ）の連結は最初からあきらめちゃいます。どうやら後輩君が１番引っかかってる部分のようですが、1つのフォームに複数のテーブルを連結することはできません（たぶん）。サブフォームを2つ使えばって考えもありますがその場合、更新のタイミングの問題も出てくると思います（例えばBを更新する際、AとCの更新は？みたいな）。イメージ的には下図のようになります。
フォームに表示する流れ
更新・削除をする流れ
VBA上でSQL文を使用して「A」「B」「C」各テーブルと「A」「B」「C」を結合した独自型をつなげ、その独自型とフォームを連動させます。独自型を使うのははっきり言って趣味です。飛ばして直でフォームにいっちゃっても問題ないと思います。それでは流れに基づいてメソッドを作ってみます。
Option Compare Database
Option Explicit
'独自型
Public Type MyData
Id As Integer 'このIdはAのId
AName As String
BName As String
CName As String
End Type
'生成メソッド
Public Function GetMyData(targetId As Long) As MyData
On Error GoTo ErrProcess
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim selectSql As String
selectSql = "SELECT A.Id, A.AName, B.BName, C.CName " _
& "FROM (A INNER JOIN B ON A.Id = B.AId) " _
& "INNER JOIN C ON A.ID = C.AId WHERE A.Id = " & targetId
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open selectSql, cn, adOpenKeyset, adLockReadOnly
Dim result As MyData
'0件はエラー、2件以上については今回は考えません
If (rs.RecordCount = 0) Then
MsgBox "レコードを取得できませんでした。", vbExclamation, "エラー"
Else
result.Id = rs!Id
result.AName = rs!AName
result.BName = rs!BName
result.CName = rs!CName
End If
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
GetMyData = result
Exit Function
ErrProcess:
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
MsgBox Err.Description, vbCritical, "エラー"
End Function
'更新メソッド
Public Sub UpdateMyData(updateData As MyData)
On Error GoTo ErrProcess
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim updateSqlA As String
updateSqlA = "UPDATE A SET AName = '" & updateData.AName & "' " _
& "WHERE Id = " & updateData.Id
Dim updateSqlB As String
updateSqlB = "UPDATE B SET BName = '" & updateData.BName & "' " _
& "WHERE AId = " & updateData.Id
Dim updateSqlC As String
updateSqlC = "UPDATE C SET CName = '" & updateData.CName & "' " _
& "WHERE AId = " & updateData.Id
cn.Execute (updateSqlA)
cn.Execute (updateSqlB)
cn.Execute (updateSqlC)
cn.Close: Set cn = Nothing
Exit Sub
ErrProcess:
cn.Close: Set cn = Nothing
MsgBox Err.Description, vbCritical, "エラー"
End Sub
'削除メソッド
Public Sub DeleteMyData(deleteData As MyData)
On Error GoTo ErrProcess
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim deleteSqlA As String
deleteSqlA = "DELETE FROM A WHERE Id = " & deleteData.Id
'連鎖削除設定してたら以下のBとCのDELETE文は不要
Dim deleteSqlB As String
deleteSqlB = "DELETE FROM B WHERE AId = " & deleteData.Id
Dim deleteSqlC As String
deleteSqlC = "DELETE FROM C WHERE AId = " & deleteData.Id
cn.Execute (deleteSqlA)
cn.Execute (deleteSqlB)
cn.Execute (deleteSqlC)
cn.Close: Set cn = Nothing
Exit Sub
ErrProcess:
cn.Close: Set cn = Nothing
MsgBox Err.Description, vbCritical, "エラー"
End Sub
やってることはシンプルにしたつもりです。あとはリスト型のフォームと入力用のフォームを用意して各メソッドを呼び出してやれば完成です。さすがにフォームは省略させて下さい。
以上が自分なりの後輩君の悩みへの解決方法です。いやぁ、後輩君はどんな方法で解決するか楽しみですね～。簡単にギブアップしないことを祈ってます。
