Acceessテーブルのレコードを条件ごとに別のテーブルに移動させるVBAコード

スポンサーリンク

AccessのVBAは難しい?

私はAccessVBAよりもExcelのVBAの方が慣れていて、AcceessのVBAは難しい気がしてしまいます。

特にワークシートと異なりデータベースのテーブルは前後のレコードを参照するのが難しく、ExcelVBAで上下の行を参照して条件分岐を書くことに慣れているのでどうにもうまく組めず敬遠しがちでした。

しかし最近たくさんのデータを扱う処理が必要になりAccessでシステムを作ってみたところ、少しコツをつかんだのか使いやすさを実感することがありました。

今回はそのシステム構築で考えた「あるテーブルのレコードを条件に沿って別のテーブルに移動させるコード」を紹介します。

今回のAccessVBAコードのポイント

今回ご紹介するコードのポイントとしては①ADOを使用すること、②対象となるテーブルのフィールド名を取得して繰り返し処理を行うことで汎用性を高くすることの2点です。

まずはこちらの2点について順に概要を記載してから、作成したVBAコードの内容をご紹介します。

スポンサーリンク

ADOを使用する

ADOとはAccessをはじめ、データベースを思い通りに操作するために必須(と思われる)のデータAccessのツールです。
ADOを使うとテーブルのレコードを順に参照したり、テーブルにレコードを追加したり、更新したりといった操作がVBA上で可能になります。

VBAのコードで操作できるようになるので、通常のクエリやSQLで記載するのと比較して複雑な条件分岐を作成することが可能です。
(もしかしてSQLの専門家ならSQLでも作れるかもしれませんが、難易度が高い気がします。)

参照設定で「Microsoft ActiveX Data Objects X.X Library」を有効にしておく必要があります。

vba159ADO参照設定

フィールド名を取得して、フィールド名が異なっていても取り込みできるようにする方法

ADOを使用していても、フィールドの数が多いと値を入力するのが面倒なことがあります。

値を入力する場合、Excelのワークシートと異なり、Accessのテーブルはフィールド名を指定するのが原則だからです。
(基本的にデータベースは全部同じだと思います。)

これはフィールド名さえきちんと指定しておけば、順序が入れ替わっても大丈夫な利点もありますが、いちいち全部のフィールド名を指定するのが面倒です。
今回はフィールド名の一覧を取得して、繰り返し処理を行うことでコードを簡略化しています。

条件に沿ってレコードを別テーブルに移動するAcccessVBAコード

今回私が考えたコードでは元のテーブルのレコードを条件によって2つのテーブルに移動させるというものです。

サンプルコードではテーブル名は「前テーブル」「後テーブル1」「後テーブル2」としています。
前テーブルの条件ごとにレコードをmoveRecord1・moveRecord2という配列にカンマ区切りで格納しておき、それをそれぞれ後テーブル1・後テーブル2に書き出すフローになっています。

注意点としてはフィールド名が異なっていても移動可能ですが、順序が違っていたり、データ型が異なっているとエラーになります。

Sub 条件ごとにテーブルに移動サンプル()

Dim CN(2) As ADODB.Connection
Dim RS(2) As ADODB.Recordset

Dim fromTable
fromTable = “前テーブル”
Dim toTable1
toTable1 = “後テーブル1”
Dim toTable2
toTable2 = “後テーブル2”

Dim moveRecord1()
Dim moveRecord2()
Dim i, k, x, y
Dim fCount

For i = 0 To 2
Set RS(i) = New ADODB.Recordset
Set CN(i) = CurrentProject.Connection
Next i

x = 0
y = 0
RS(0).Open “[” & fromTable & “]”, CN(0), adOpenKeyset, adLockOptimistic
fCount = RS(0).Fields.Count

RS(0).MoveFirst
Do Until RS(0).EOF
If IsNull(RS(0)![氏名]) Then ’氏名フィールドが空欄なら
ReDim Preserve moveRecord1(x)
For k = 0 To RS(0).Fields.Count - 1
moveRecord1(x) = moveRecord1(x) & “,” & RS(0).Fields(k) ’移動するレコードをカンマ区切りのmoveRecord1(x)に格納
Next k
moveRecord1(x) = Mid(moveRecord1(x), 2) ’最初のカンマ削除
x = x + 1

Else
ReDim Preserve moveRecord2(y)
For k = 0 To RS(0).Fields.Count - 1
moveRecord2(y) = moveRecord2(y) & “,” & RS(0).Fields(k) ’移動するレコードをカンマ区切りのmoveRecord2(y)に格納
Next k
moveRecord2(y) = Mid(moveRecord2(y), 2) ’最初のカンマ削除
y = y + 1

End If

RS(0).MoveNext
Loop
RS(0).Close

Dim fieldName()
Dim moveRecordIndex
ReDim fieldName(fCount - 1)

’後テーブル1にレコードを書き出す
With RS(1)
.Open “[” & toTable1 & “]”, CN(1), adOpenKeyset, adLockOptimistic
For k = 0 To fCount - 1
fieldName(k) = RS(1).Fields(k).Name
Next k

For i = 0 To UBound(moveRecord1)
addRecord = Split(moveRecord1(i), “,”)
.AddNew
For k = 0 To fCount - 1
.Fields(fieldName(k)) = addRecord(k)
Next k
.Update
Next i
.Close

End With

’後テーブル2にレコードを書き出す
With RS(2)
.Open “[” & toTable2 & “]”, CN(1), adOpenKeyset, adLockOptimistic
For k = 0 To fCount - 1
fieldName(k) = RS(1).Fields(k).Name
Next k

For i = 0 To UBound(moveRecord2)
addRecord = Split(moveRecord2(i), “,”)
.AddNew
For k = 0 To fCount - 1
.Fields(fieldName(k)) = addRecord(k)
Next k
.Update
Next i
.Close

End With

For i = 0 To 2
Set RS(i) = Nothing
Set CN(i) = Nothing
Next i

Dim strSQL

’SQLを実行して別のテーブルに追加したデータを削除する
strSQL = “DELETE * FROM [” & fromTable & “];”

DoCmd.SetWarnings False
DoCmd.RunSQL (strSQL)
DoCmd.SetWarnings True

End Sub

このコードではレコードの中にカンマが含まれているとエラーになる可能性がありますので、コードが複雑になりますがカンマ区切りの文字列にするよりも直接移動させた方が良いかもしれません。

良い方法思いついたらまたご紹介します。

コメント