2012/08/29

【Access】複数のテーブルを1つのフォームで更新する方法を考える【VBA】

 後輩君が何やら頭を抱えて悩んでいたので聞いてみた。

「現在とある業務で使用してる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番引っかかってる部分のようですが、1つのフォームに複数のテーブルを連結することはできません(たぶん)。サブフォームを2つ使えばって考えもありますがその場合、更新のタイミングの問題も出てくると思います(例えばBを更新する際、AとCの更新は?みたいな)。イメージ的には下図のようになります。

フォームに表示する流れ
image

更新・削除をする流れ
image

 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


 やってることはシンプルにしたつもりです。あとはリスト型のフォームと入力用のフォームを用意して各メソッドを呼び出してやれば完成です。さすがにフォームは省略させて下さい。


 以上が自分なりの後輩君の悩みへの解決方法です。いやぁ、後輩君はどんな方法で解決するか楽しみですね~。簡単にギブアップしないことを祈ってます。
pagetop