ADOのExecuteメソッドで交互にエラーが出る

質問

こんにちは。

ExcelでADO+ODBCを用いてローカルのMySQLにアクセスしています。
とあるサイトから参考にさせてもらって作成した以下のソースで、
シート上のボタンをクリックしたら
ODBCに設定したDSNのテーブル一覧をシートに出力
するというマクロなのですが、実行してみると正常終了とエラーが交互に繰り返されます。

エラーが出るときにデバッグしてみると標準モジュールの
Set adoRS = adoCON.Execute("SHOW TABLES;")
を実行した時点でエラー（赤丸の×でエラー説明なし）がでて強制終了します。

この原因について心当たりがありましたら教えてください。

****シートモジュール****
Private dsn As String
Private uid As String
Private pwd As String
Private strsql As String

Sub para_get()
dsn = Range("C6")
uid = Range("C7")
pwd = Range("C8")
strsql = Range("C9")
End Sub

Sub ボタン1_Click()
Dim errflag As Integer
errflag = 0
Call para_get
errflag = DBconnect(dsn, uid, pwd)
If errflag <> 0 Then
MsgBox "データベースに接続できませんでした"
Else
MsgBox "データベースに接続できました"
End If
errflag = sql_exe
End Sub

*****標準モジュール******
Dim adoCON As New ADODB.Connection

Public Function DBconnect(dsn As String, uid As String, pwd As String)
Dim errflag As Integer
errflag = -1

On Error GoTo errflag
'Access VBA Tips
'4.5 MySQLのデータベースを開く・閉じる

'ADOでデータソースをオープン
adoCON.Open "dsn=" & dsn & ";uid=" & uid & ";pwd=" & pwd & ";"
errflag = 0
Exit Function

errflag:
'データベースのクローズ
adoCON.Close
Set adoCON = Nothing
End Function

Function sql_exe() As Integer
Dim adoRS As New ADODB.Recordset

'レコードセットの作成(SELECT文の実行)
Set adoRS = adoCON.Execute("SHOW TABLES;")
Range("B15").CopyFromRecordset adoRS

'データベースのクローズ
adoRS.Close
Set adoRS = Nothing
End Function

回答No.2

Siegrune · ベストアンサー

うまくいってよかったですね。

>ボタン1_Click()ではなくsql_exe() の方ですよね？
これは、いまのソースでは、どちらでも問題ないです。
とにかくボタン1_Click()の処理が終わる前にcloseしてください
との趣旨でした。

On Error GoTo 0
の説明の前に
On Error GoTo errflag
とは、エラーがおきたときに
errflag:
以下の処理をしなさいという命令です。
で、resume nextでエラーが起きた次の命令へ処理を戻すとか。
exit subやexit functionで、処理を終了させるとかします。
(今回はend functionなので、exit functionと同様かな。)
ということで、
On Error GoTo 0
は、エラーが起きたときにどこへも制御を移さずにエラーを表示させる（つまりは普通の）状態に
戻す命令です。

今回の場合、
On Error GoTo errflag
の後に
adoCON.Open "dsn=" & dsn & ";uid=" & uid & ";pwd=" & pwd & ";"
errflag = 0
Exit Function
しかないので、ま、いいといえばいいのでしょうが、
例えば、errflagが日付型になっていたりすると（ソースを見る限りありえないですが）
errflag = 0
でエラーが起きたのに、errflag:へいってclose処理してfunctionを終わるという動きになり
想定外の動きをしてしまうことになります。⇒バグの元になりやすいというだけです。

追伸：
私が、「お行儀悪い」って書いているのは、直さなくてもプログラムソースの書き方に
よってはうまくいくこともあるのだが、バグの元になりやすい書き方に対して言っているだけで、
他意はないです。
（未熟者とか言っているつもりはないのですが誤解されたようでしたらすいません。）

回答No.3

30246kiku

ご質問への回答は出ていますので、以下は余談（補足）的なものとしてください。

提示された記述が全コードだとした場合、

・Function　の戻り値が設定されていない
　（暗黙の 0 しか戻らないので、特に DBconnect後の、接続失敗は通らない）

　DBconnectは戻り値の型を明示（宣言）していないので、Variant
　値を設定していないので Empty
　Empty を Integer で解釈すると 0（ Empty を String で解釈すると "" ）

　sql_exeでは、戻り値の型を Integer 宣言
　戻り値は、初期値 0 に設定されるが　sql_exe = XX していないので 0 のまま

・sql_exe を標準モジュールに置くのなら、SQL/Rangeを固定した書き方にしない

・シート側では、直接 ADO 用の変数を参照しない
　（必要なら関数経由とする：適宜関数を作る）

２つ目、３つ目については、私はそう思うっていうだけです。

以下たたき台にしてみてください。(環境が無いので、動作未検証)
（行儀についてはわかりません）

標準モジュールに以下

Dim adoCON As ADODB.Connection

Public Sub DBdisConnect()
　　On Error Resume Next
　　If (adoCON Is Nothing) Then Exit Sub
　　If (adoCON.State = adStateOpen) Then adoCON.Close
　　Set adoCON = Nothing
End Sub

Public Function DBconnect(dsn As String, uid As String, pwd As String) As Integer
　　Dim errflag As Integer

　　errflag = 0
　　On Error GoTo ERR_HND
　　Call DBdisConnect　　　' 念のため
　　Set adoCON = New ADODB.Connection
　　adoCON.Open "dsn=" & dsn & ";uid=" & uid & ";pwd=" & pwd & ";"

ERR_EXIT:
　　DBconnect = errflag
　　Exit Function

ERR_HND:
　　errflag = -1
　　Call DBdisConnect
　　Resume ERR_EXIT
End Function

Public Function sql_exe(sSql As String, rng As Range) As Integer
　　Dim adoRS As ADODB.Recordset
　　Dim errflag As Integer

　　errflag = 0
　　On Error GoTo ERR_HND
　　Set adoRS = adoCON.Execute(sSql)
　　rng.CopyFromRecordset adoRS
　　adoRS.Close

ERR_EXIT:
　　Set adoRS = Nothing
　　sql_exe = errflag
　　Exit Function

ERR_HND:
　　errflag = -1
　　If (Not adoRS Is Nothing) Then adoRS.Close
　　Resume ERR_EXIT
End Function

シート側に以下

Private dsn As String
Private uid As String
Private pwd As String
Private strsql As String

Private Sub para_get()
　　dsn = Range("C6")
　　uid = Range("C7")
　　pwd = Range("C8")
'　　strsql = Range("C9")
　　strsql = "SHOW TABLES;"
End Sub

Sub ボタン1_Click()
　　Call para_get
　　If (DBconnect(dsn, uid, pwd) = 0) Then
　　　　If (sql_exe(strsql, Range("B15")) <> 0) Then
　　　　　　MsgBox "データ取得でエラー"
　　　　End If
　　　　Call DBdisConnect
　　Else
　　　　MsgBox "データベースに接続できませんでした"
　　End If
End Sub

とか

Sub ボタン1_Click()
　　Call para_get
　　If (DBconnect(dsn, uid, pwd) = 0) Then
　　　　Call sql_exe(strsql, Range("B15"))
　　　　Call DBdisConnect
　　Else
　　　　MsgBox "データベースに接続できませんでした"
　　End If
End Sub

回答No.1

Siegrune

>実行してみると正常終了とエラーが交互に繰り返されます。
一回目は正常終了ですか？それともエラーですか？

★１回目
Sub ボタン1_Click()
Dim errflag As Integer
errflag = 0
Call para_get
errflag = DBconnect(dsn, uid, pwd)
'★★★ここで、adoCON.Openが行われる。
If errflag <> 0 Then
MsgBox "データベースに接続できませんでした"
Else
MsgBox "データベースに接続できました"
End If
errflag = sql_exe
'★★★ここでは、adoCONはcloseしていない。
End Sub

★２回目
Sub ボタン1_Click()
Dim errflag As Integer
errflag = 0
Call para_get
errflag = DBconnect(dsn, uid, pwd)
'★★★ここで、adoCON.OpenをしようとしてすでにOPEN状態なのでエラー。
'★★★エラー処理でadoCON.closeされる。
If errflag <> 0 Then
MsgBox "データベースに接続できませんでした"
Else
MsgBox "データベースに接続できました"
End If
'★★★"データベースに接続できませんでした"とでていると思いますが！
errflag = sql_exe
'★★★ここで、adoCONがclose状態なのでエラー！！！
End Sub

と動いていそうですが。

●Openしたままなのはお行儀悪いです。
Sub ボタン1_Click()
の最後で、
adoCON.Close
Set adoCON = Nothing
をしましょう。

●On Error Gotoの使い方もお行儀悪いです。
思わぬ処理が走る原因になりかねません。

On Error GoTo errflag
'Access VBA Tips
'4.5 MySQLのデータベースを開く・閉じる

'ADOでデータソースをオープン
adoCON.Open "dsn=" & dsn & ";uid=" & uid & ";pwd=" & pwd & ";"
On Error GoTo 0 '正常に処理が終わったら元に戻す。
errflag = 0
Exit Function

errflag:
On Error GoTo 0 'エラー処理が呼び出されても元に戻す。
'データベースのクローズ
adoCON.Close
Set adoCON = Nothing
End Function

●接続失敗して後続処理を実行するのはよろしくありません。
If errflag <> 0 Then
MsgBox "データベースに接続できませんでした"
exit sub '★処理を終了する！！！
Else

補足

回答ありがとうございます。
未熟者で行儀の悪いソースですいません。

＞●Openしたままなのはお行儀悪いです。
Sub ボタン1_Click()
の最後で、
adoCON.Close
Set adoCON = Nothing
をしましょう。

ボタン1_Click()ではなくsql_exe() の方ですよね？
adoCONをcloseしてたと思ったらエラーのときしかcloseされてないですね。。。
closeしたらうまくいきました。
（ちなみにエラーは2回目の時です。）

＞●On Error Gotoの使い方もお行儀悪いです。
思わぬ処理が走る原因になりかねません。

On Error GoTo 0
は初めて見ましたがこの処理はどういうときに
必要なのでしょうか？実際、使用していなくても
うまく動作しており、引用元にもこのような
記載はなかったので教えていただけると嬉しいです。