ExcelでSQLを使う-019: ソース公開-03 CnnExecute関数（Excel←→Access）
新生児期の中盤も過ぎて、仔犬たちの食欲（？）はますます盛ん。
黄色ちゃんと水色ちゃんの体重は、早くもIkgをオーバーしました。
文献によれば、体重が２倍になるのは2週齢頃。
が、３回共に1週齢と1日~2日で生誕時の倍の体重になっている。
◇◇◇◇◇
3、SQL文を実行するCnnExecutet関数
RunSQL メソッド (Access)
RunSQLメソッドは、Visual Basic で RunSQL アクションを実行します。
Access の DoCmd オブジェクトは RunSQLメソッドをサポートしています。CnnExecute関数は、RunSQLメソッドの類似品です。
【Access 標準ライブラリ】
Public Function CnnExecute(ByVal strSQL As String) As Boolean
On Error GoTo Err_CnnExecute
Dim isOK As Boolean
Dim cnn As ADODB.Connection
isOK = True
Set cnn = CurrentProject.Connection
With cnn
.Errors.Clear
.BeginTrans
.Execute strSQL
.CommitTrans
End With
Exit_CnnExecute:
On Error Resume Next
cnn.Close
Set cnn = Nothing
CnnExecute = isOK
Exit Function
Err_CnnExecute:
isOK = False
If cnn.Errors.Count > 0 Then
ErrMessage cnn.Errors(0), strSQL
cnn.RollbackTrans
Else
MsgBox "プログラムエラーが発生しました。" & _
"システム管理者に報告して下さい。(CnnExecute)", _
vbExclamation, " 関数ｴﾗｰﾒｯｾｰｼﾞ"
End If
Resume Exit_CnnExecute
End Function
Public Sub ErrMessage(ByVal CnnErrors As ADODB.Error, ByVal strSQL As String)
MsgBox "ADOｴﾗｰが発生しましたので処理をｷｬﾝｾﾙします。" & Chr$(13) & Chr$(13) & _
"・Err.Description=" & CnnErrors.Description & Chr$(13) & _
"・Err.Number=" & CnnErrors.Number & Chr$(13) & _
"・SQL State=" & CnnErrors.SQLState & Chr$(13) & _
"・SQL Text=" & strSQL, _
vbExclamation, " ADO関数ｴﾗｰﾒｯｾｰｼﾞ"
End Sub
【Excel 標準ライブラリ】
Public Function CnnExecute(ByVal strSQL As String, _
ByVal strDB As String) As Boolean
On Error GoTo Err_CnnExecute
Dim isOK As Boolean
Dim DataValue
Dim cnn As Object
isOK = True
' ---------------
' Set
' ---------------
Set cnn = CreateObject("ADODB.Connection")
' ----------------------------------
' データベース オープン
' ----------------------------------
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB & ";"
With cnn
.Errors.Clear
.BeginTrans
.Execute strSQL
.CommitTrans
End With
Exit_CnnExecute:
On Error Resume Next
cnn.Close
Set cnn = Nothing
CnnExecute = isOK
Exit Function
Err_CnnExecute:
isOK = False
Debug.Print strSQL
If cnn.Errors.Count > 0 Then
ErrMessage cnn.Errors(0), strSQL
cnn.RollbackTrans
Else
MsgBox "プログラムエラーが発生しました。" & _
"システム管理者に報告して下さい。(CnnExecute)", _
vbExclamation, " 関数ｴﾗｰﾒｯｾｰｼﾞ"
End If
Resume Exit_CnnExecute
End Function
ErrMessage関数の書き方は、AccessもExcelも一緒です。
エラー発生時には変更を破棄
（私の解釈では）CnnExcecute関数は、.BeginTransで処理を開始します。ただし、その処理はバッファ内で実行されて .CommitTrans でテーブルを更新します。エラー発生時には、.RollbackTrans が呼ばれバッファ内の処理は破棄されてテーブルは更新されることはありません。
CnnExecute関数の使用例_1
CnnExecute関数は、極論すれば僅か１行の関数。でも、使いようでは、強力な力を発揮します。例えば、同関数を用いて[成績表]に列[順位]を追加することもできます。
Sub Macro3()
Dim isOK As Boolean
Dim strSQL As String
Dim strDb As String
strSQL = "ALTER TABLE 成績表 ADD 順位 Int;"
strDb = "D:\Db1.mdb"
isOK = CnnExecute(strSQL, strDb)
If isOK Then
Message "ALTER TABLE を実行しました。"
End If
End Sub
CnnExecute関数の使用例_2
CnnExecute関数が真価を発揮するのは、成績表の順位を更新するなどの場合です。
Sub Macro4()
On Error GoTo Err_Macro4
Dim isOK As Boolean
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim intNewScore As Integer
Dim intNowScore As Integer
Dim intNowID As Integer
Dim intRowCount As Integer
Dim strSQL1 As String
Dim strSQL2 As String
Dim strDB As String
strSQL1 = "UPDATE 成績表 SET 順位=XXXXX WHERE ID=YYYYY"
strDB = "d:\Db1.mdb"
intRowCount = DBLookup("SELECT Count(*) FROM 成績表", strDB)
If intRowCount > 0 Then
K = 1
For I = 1 To intRowCount
J = J + 1
intNowID = DBLookup("SELECT ID FROM 成績表 ORDER BY 成績 DESC", strDB, I)
intNewScore = DBLookup("SELECT 成績 FROM 成績表 ORDER BY 成績 DESC", strDB, I)
If intNowScore <> intNewScore Then
K = J
intNowScore = intNewScore
End If
strSQL2 = Replace(strSQL1, "XXXXX", K)
strSQL2 = Replace(strSQL2, "YYYYY", intNowID)
isOK = CnnExecute(strSQL2, strDB)
If Not isOK Then
GoTo Err_Macro4
End If
Next I
End If
If isOK Then
Message "成績表を更新しました。"
End If
Exit_Macro4:
Exit Sub
Err_Macro4:
ErrorMsg "成績表の更新に失敗しました。"
Resume Exit_Macro4
End Sub
DBLookup関数の引数（何番目を取得するのか）を値渡しにしていて首尾よい結果を得られずに焦りましたが、何とか成績表の順位を更新できました。同点同位の処理がありますのでマクロが複雑になっています。しかし、かなり簡単に順位付けできたと思います。
次稿では DBWriter関数とSheetWriter関数を紹介します。
