先日Accessで作成したJリーグの順位表データベースをお試しでMariaDBへ移行してみました。
基本的にはちまちま、MariaDBでテーブルの新規作成をした後、Access側でレコードセットを取得し、MariaDBへINSERTする、という単純なものです。
順位の計数のスクリプトがフォーム上にあったので、せっかくなので(?)クラスモジュールに変更してみました。
MariaDBをダウンロード
MariaDBというデータベースエンジンがございますのでそちらをダウンロードし、使用する準備をする必要があります。詳しくは以前の記事にちょっと似た内容がありますのでどうぞ。
MariaDBをAccessから操作する、という方針です。AccessとMariaDBを橋渡ししてくれるODBCドライバと、Windwosに標準装備されているODBCデータソースアドミニストレーターというアプリを使用します。
MariaDBでデータベースを作成する
MariaDBのインストールと接続準備ができましたら、MariaDBのコマンドプロンプトで移植先のデータベースを作成します。
CREATE DATABASE J_LeagueData
DEFAULT CHARACTER SET utf8mb4
COLLATE utf8mb4_general_ci;
どうやら、作業用のユーザーを作成するのがセオリーみたいです。後ほどユーザー名とパスワードは使用するのでメモしておきます。
CREATE USER 'access_user'@'%' IDENTIFIED BY 'your_secure_password';
GRANT ALL PRIVILEGES ON J_LeagueData.* TO 'access_user'@'%';
FLUSH PRIVILEGES;
MariaDBにテーブルを新規作成する
データベースができました、テーブルを作成して受け入れ態勢を整えておきます。
AccessとMariaDBではややデータ型の表記などが異なるようで注意が必要です。
今回のデータベースには「Matches」テーブル「Points」テーブル「Teams」テーブルがありますので、作成します。
なるほど、こういうことが起きるのを想定してAccessでも英語風のテーブル名にしておくのは便利ですね。
CREATE TABLE Matches (
match_id INT AUTO_INCREMENT PRIMARY KEY,
season INT,
matchday INT,
match_date DATE,
home_team_id INT,
away_team_id INT,
home_score INT,
away_score INT
);CREATE TABLE Points (
matchday INT,
team_id INT,
season INT,
total_points INT,
goals_for INT,
goals_against INT,
goal_diff INT,
rank INT,
PRIMARY KEY (matchday, team_id, season)
);CREATE TABLE Teams (
team_id INT PRIMARY KEY,
team_name VARCHAR(100)
);
3つのテーブルが作成できました。
Access側からMariaDBへ移行する
いよいよAccess側から、MariaDBへ移行していきます。
移植用のVBAを標準モジュールに用意して使用しました。
基本的には各テーブルの全件を取得して、MariaDBへINSERTするSQL文を成形して使用する、という流れです。
今まではDAO使用していたのですが、MariaDBとの接続にはADODBオブジェクトを使用する必要があるようです。
…そう言われるとなんかインターネットで見たことある…。
ですので、VBEの「ツール」「参照設定」から、「Microsoft ActiveX Data Objects 6.1 Library」にチェックを入れて使用しました。
Sub InsertMatches()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
'① Access側のローカルMatchesACから全件取得
Set rs = New ADODB.Recordset
rs.Open "SELECT season, matchday, match_date, home_team_id, away_team_id, home_score, away_score FROM MatchesAC", _
CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
'② MariaDBへ接続
Set conn = New ADODB.Connection
conn.Open "DSN=JLeagueDB;" ' DSNはMariaDB用のもの
'③ MariaDBへ1件ずつINSERT
Do Until rs.EOF
strSQL = "INSERT INTO Matches (season, matchday, match_date, home_team_id, away_team_id, home_score, away_score) VALUES (" & _
rs!season & ", " & rs!matchday & ", '" & Format(rs!match_date, "yyyy-mm-dd") & "', " & _
rs!home_team_id & ", " & rs!away_team_id & ", " & rs!home_score & ", " & rs!away_score & ")"
conn.Execute strSQL
rs.MoveNext
Loop
'④ 後処理
rs.Close: Set rs = Nothing
conn.Close: Set conn = Nothing
MsgBox "試合データをMariaDBに登録しました！", vbInformation
End Sub
Sub InsertPoints()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
'① Access側からデータ取得
Set rs = New ADODB.Recordset
rs.Open "SELECT matchday, team_id, season, total_points, goals_for, goals_against, goal_diff, rank FROM PointsAC", _
CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
'② MariaDBへ接続
Set conn = New ADODB.Connection
conn.Open "DSN=JLeagueDB;"
'③ MariaDBへINSERT
Do Until rs.EOF
strSQL = "INSERT INTO Points (matchday, team_id, season, total_points, goals_for, goals_against, goal_diff, rank) VALUES (" & _
rs!matchday & ", " & rs!team_id & ", " & rs!season & ", " & rs!total_points & ", " & _
rs!goals_for & ", " & rs!goals_against & ", " & rs!goal_diff & ", " & rs!rank & ")"
conn.Execute strSQL
rs.MoveNext
Loop
'④ 終了処理
rs.Close: Set rs = Nothing
conn.Close: Set conn = Nothing
MsgBox "ポイントデータをMariaDBに登録しました！", vbInformation
End Sub
Sub InsertTeams()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
'① Accessローカルからデータ取得
Set rs = New ADODB.Recordset
rs.Open "SELECT team_id, team_name FROM TeamsAC", _
CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
'② MariaDBへ接続
Set conn = New ADODB.Connection
conn.Open "DSN=JLeagueDB;" ' ← DSNはMariaDB側を指定
'③ INSERT処理（1件ずつ）
Do Until rs.EOF
strSQL = "INSERT INTO Teams (team_id, team_name) VALUES (" & _
rs!team_id & ", '" & Replace(rs!team_name, "'", "''") & "')"
conn.Execute strSQL
rs.MoveNext
Loop
'④ 終了処理
rs.Close: Set rs = Nothing
conn.Close: Set conn = Nothing
MsgBox "クラブデータをMariaDBに登録しました！", vbInformation
End Sub
Sub TestConnect()
Dim conn As Object
Set conn = CreateObject("ADODB.Connection")
conn.Open "DSN=JLeagueDB;"
MsgBox "接続成功！"
conn.Close
End Su
基本的には同じことをテーブル3つ分行っています。念のためAccess側のテーブルの名前を変更してから行いました。
最後は別の記事にも記載しましたが、「外部データ」タブからINSERTしたテーブルへの接続をすれば、元通りになります。
フォーム更新スクリプトを修正
最後はテーブルの更新用にVBAのスクリプトを使用していましたので、そちらもMariaDBを更新するように修正します。
やはりDAOを使用していましたので、ADODBからMariaDBを使用する形へ修正しました。
こういう時のために、やはり技術的な要素に依存する部分は別のクラスモジュールにしてインターフェースをかましてカプセル化しておくのが良かったようです。
せっかくなので、クラスモジュールに変更しました。
IPointsRepository
Option Compare
DatabaseOption Explicit
Public Sub InsertPoints(seasonTarget As Integer, matchdayTarget As Integer)
End SubMariaDBPointsRepository
Option Compare Database
Option Explicit
Implements IPointsRepository
Public Sub IPointsRepository_InsertPoints(seasonTarget As Integer, matchdayTarget As Integer)
Dim conn As ADODB.Connection
Dim rsTeams As ADODB.Recordset
Dim teamID As Long
Dim strSQL As String
Dim totalPoints As Long, gf As Long, ga As Long
' 接続設定（MariaDBへのDSN）
Set conn = New ADODB.Connection
conn.Open "DSN=JLeagueDB;" ' ← 自宅・職場で同じDSN名で揃えると便利です
' ① 指定年度・節の既存レコードを削除
strSQL = "DELETE FROM Points WHERE season = " & seasonTarget & " AND matchday = " & matchdayTarget
conn.Execute strSQL
' ② MariaDB側のTeams一覧を取得
Set rsTeams = New ADODB.Recordset
rsTeams.Open "SELECT team_id FROM Teams", conn, adOpenForwardOnly, adLockReadOnly
' ③ 各チームごとに集計しINSERT
Do Until rsTeams.EOF
teamID = rsTeams!team_id
' 勝ち点集計
strSQL = "SELECT SUM(CASE " & _
"WHEN home_team_id=" & teamID & " AND home_score>away_score THEN 3 " & _
"WHEN away_team_id=" & teamID & " AND away_score>home_score THEN 3 " & _
"WHEN (home_score=away_score AND (home_team_id=" & teamID & " OR away_team_id=" & teamID & ")) THEN 1 " & _
"ELSE 0 END) AS pts " & _
"FROM Matches WHERE season=" & seasonTarget & " AND matchday <= " & matchdayTarget & " " & _
"AND (home_team_id=" & teamID & " OR away_team_id=" & teamID & ")"
totalPoints = Nz(conn.Execute(strSQL).Fields(0).Value, 0)
' 得点集計
strSQL = "SELECT SUM(CASE " & _
"WHEN home_team_id=" & teamID & " THEN home_score " & _
"WHEN away_team_id=" & teamID & " THEN away_score " & _
"ELSE 0 END) AS gf " & _
"FROM Matches WHERE season=" & seasonTarget & " AND matchday <= " & matchdayTarget & " " & _
"AND (home_team_id=" & teamID & " OR away_team_id=" & teamID & ")"
gf = Nz(conn.Execute(strSQL).Fields(0).Value, 0)
' 失点集計
strSQL = "SELECT SUM(CASE " & _
"WHEN home_team_id=" & teamID & " THEN away_score " & _
"WHEN away_team_id=" & teamID & " THEN home_score " & _
"ELSE 0 END) AS ga " & _
"FROM Matches WHERE season=" & seasonTarget & " AND matchday <= " & matchdayTarget & " " & _
"AND (home_team_id=" & teamID & " OR away_team_id=" & teamID & ")"
ga = Nz(conn.Execute(strSQL).Fields(0).Value, 0)
' INSERT文を構築
strSQL = "INSERT INTO Points (season, matchday, team_id, total_points, goals_for, goals_against, goal_diff, rank) VALUES (" & _
seasonTarget & ", " & matchdayTarget & ", " & teamID & ", " & totalPoints & ", " & _
gf & ", " & ga & ", " & (gf - ga) & ", 0)"
conn.Execute strSQL
rsTeams.MoveNext
Loop
' 後処理
rsTeams.Close: Set rsTeams = Nothing
conn.Close: Set conn = Nothing
'Me.lblLog.Caption = seasonTarget & "年 第" & matchdayTarget & "節 の順位集計が完了しました！（MariaDB版）"
End Su
PointsService
Option Compare Database
Option Explicit
Private repository_ As IPointsRepository
Public Sub InjectRepository(repository As IPointsRepository)
Set repository_ = repository
End Sub
Public Sub AwardPoints(seasonTarget As Integer, matchdayTarget As Integer)
If Not repository_ Is Nothing Then
Call repository_.InsertPoints(seasonTarget, matchdayTarget)
End If
End Su
Form_F_PointsUpdate
Option Compare Database
Option Explicit
'ツール、参照設定
'Microsoft ActiveX Data Objects 6.1 Library にチェック
Private Mediator As Mediator
Private ColleagueCommandButtonCollection As Collection
Private Const IDNAME As String = "team_id"
Private Const SUBFORM_NAME As String = "F_Pints_RankedStats"
Private PointsService As PointsService
Private Sub cmbMatchday_AfterUpdate()
Call RequerySubForm
End Sub
Private Sub cmbSeason_AfterUpdate()
Call RequerySubForm
End Sub
Private Sub Form_Load()
Me.lblLog.Caption = ""
Set Mediator = New Mediator
Call Mediator.Construct(Me, IDNAME)
Dim CreateColleagueCommandButton As CreateColleagueCommandButton
Set CreateColleagueCommandButton = New CreateColleagueCommandButton
Set ColleagueCommandButtonCollection = CreateColleagueCommandButton.Create(Me)
Set PointsService = New PointsService
Call PointsService.InjectRepository(New MariaDBPointsRepository)
End Sub
Public Sub CommandButtonNotify(form_name As String)
Call Mediator.CommandButtonNotify(form_name)
End Sub
Private Sub CommandButtonUpdate_Click()
If IsNull(Me.cmbSeason) Or IsNull(Me.cmbMatchday) Then
MsgBox "年度と節を選択してください。", vbExclamation
Exit Sub
End If
Call PointsService.AwardPoints(Me.cmbSeason, Me.cmbMatchday)
Me.lblLog.Caption = Me.cmbSeason & "年 第" & Me.cmbMatchday & "節 の順位集計が完了しました！（MariaDB版）"
Me.Form.Form(SUBFORM_NAME).Requery ' 表示用サブフォームの再読み込み
End Sub
Private Sub RequerySubForm()
Me.Form.Form(SUBFORM_NAME).Requery
Me.lblLog.Caption = ""
End Sub
一つのプロシージャが3つのクラスに増えました。やや増長かもしれませんが、せっかくなので。
データベースなど技術的な部分を操作するスクリプトはフォームモジュールにあるよりはいいのかなぁと思います。依存関係逆転の法則ですね。