Excelを更新するADOの書き方を教えて下さい。

質問

.Provider = "MSDASQL"
　　cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
　　　　　　　　　　　　　 "DBQ=" & xlFileName & ";" & _
　　　　　　　　　　　　　 "ReadOnly=False;"
　　If isHeader Then
　　　 .Properties("Extended Properties") = "Excel 12.0;HDR=YES;IMEX=1"
　　Else
　　　 .Properties("Extended Properties") = "Excel 12.0;HDR=NO;IMEX=1"
　　End If
　　.Open
　　.Execute strSQL

という書き方では、動作します。また、"Microsoft.ACE.OLEDB.12.0;"バージョンでも

　　cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB & ";"
　　With cnn
　　　　 .Errors.Clear
　　　　 .BeginTrans
　　　　 .Execute strSQL
　　　　 .CommitTrans
　　End With

という書き方で、Access の mdb は更新できます。エクセルのシートを Recordset としてオープンすれば、下記の接続設定でも読むことは出来ます。非同期を指定すれば、エラーは回避できますがシートは更新されていません。当方、VBAを書くのは1996年以来。なんとか、この問題を解決して一区切りを付けたいと思っています。宜しく、ご協力の程お願いしておきます。

Public Function SQLExecute(ByVal strSQL As String, _
　　　　　　　　　　　　　 Optional xlFileName As String = "", _
　　　　　　　　　　　　　 Optional isHeader As Boolean = True) As Boolean
On Error GoTo Err_SQLExecute
　　Dim isOK As Boolean
　　Dim DataValue
　　Dim cnn As ADODB.Connection

　　isOK = True
　　Set cnn = New ADODB.Connection
　　'
　　' ThisWorkbook.FullName の指定
　　'
　　If Not Len(xlFileName) Then
　　　　 xlFileName = ThisWorkbook.FullName
　　End If
　　'
　　' 接続設定
　　'
　　With cnn
　　　　.Provider = "Microsoft.ACE.OLEDB.12.0;"
　　　　If isHeader Then
　　　　　　.Properties("Extended Properties") = "Excel 12.0;HDR=YES;IMEX=1"
　　　　Else
　　　　　　.Properties("Extended Properties") = "Excel 12.0;HDR=NO;IMEX=1"
　　　　End If
　　　　.Open xlFileName
　　　　.Errors.Clear
　　　　.BeginTrans
　　　　.Execute strSQL
　　　　.CommitTrans
　　End With
Exit_SQLExecute:
On Error Resume Next
　　cnn.Close
　　Set cnn = Nothing
　　SQLExecute = isOK
　　Exit Function
Err_SQLExecute:
　　isOK = False
　　If cnn.Errors.Count > 0 Then
　　　　ErrMessage cnn.Errors(0), strSQL
　　　　cnn.RollbackTrans
　　Else
　　　　MsgBox "プログラムエラーが発生しました。" & _
　　　　　　　 "システム管理者に報告して下さい。(SQLExecute)", _
　　　　　　　 vbExclamation, " 関数エラーメッセージ"
　　End If
　　Resume Exit_SQLExecute
End Function

回答No.2

HohoPapa · ベストアンサー

普段エクセルを相手にSQLを使うのは
専らselect文だけなので詳しくはわかりませんが．．．

Provider = "Microsoft.ACE.OLEDB.12.0"
Properties("Extended Properties") = "Excel 12.0;HDR=YES;IMEX=1"

は、
Update文は想定していないんだろうと思います。

代えて、以下のコードなら処理が可能です。
（ＭＳから動作保証が受けられるコードか？はわかりません）

Sub Sample4()

　Dim cn As Object
　'Dim rs As Object
　Dim wkSQL As String

　Set cn = CreateObject("ADODB.Connection")
　'Set rs = CreateObject("ADODB.Recordset")
　cn.Provider = "Microsoft.Jet.OLEDB.4.0"
　cn.Properties("Extended Properties") = "Excel 8.0"

'　cn.Provider = "Microsoft.ACE.OLEDB.12.0"
'　cn.Properties("Extended Properties") = "Excel 12.0;HDR=YES;IMEX=1"

　cn.Open ThisWorkbook.FullName

　'SQL文組み立て
　wkSQL = ""
　wkSQL = wkSQL & "Update [Sheet6$A1:Z100] " & vbCrLf
　wkSQL = wkSQL & "Set [備考] = Null" & vbCrLf

　'SQL文実行
　cn.Execute wkSQL

　'後処理
' rs.Close
' Set rs = Nothing
　cn.Close
　Set cn = Nothing

End Sub

お礼

私の今の結論は、回答者のそれと一緒です。で、現実問題、ODBC(?)を利用すれば、Executeで更新することも可能です。が、その手法には、一つの問題点を含んでいます。それは、シートの列の型に応じて更新、あるいは追加しないということです。並べて、文字列として処理するようです。ですから、単に、Execute でも出来るってことを確認して「ホウッ！」と自己満足するだけ。多分、OLEで出来たとしても同じ結果になると推察します。で、使い物にもならんツールに挑むのは諦めようかなーと思いつつあります。まあ、「ホウッ！」の一言のために、今しばし、質問は締め切りませんが・・・。

　今は、次のSQLExecute()を別の角度から実現する方向に転進しています。それは、質問者の提示したやり方です。見て目は、一緒ですが、中身を変えて書き始めました。

? SQLExecute("UPDATE 表名 SET 列名=値 条件")
OK
? SQLExecute("INSERT INTO 表名 条件")
OK
? SQLExecute("DELETE FROM 表名 条件")
OK

　ところで、質問者のやり方は、既に実現しています。

[イミディエイト]
? SQLWriter("SELECT * FROM [Sheet1$A1:CZ]", "Sheet2",,,1)

Public Function SQLWriter(ByVal strSQL As String, _
　　　　　　　　　　　　　ByVal strSheetName As String, _
　　　　　　　　　　　　　Optional xlFileName As String = "", _
　　　　　　　　　　　　　Optional isHeader As Boolean = True, _
　　　　　　　　　　　　　Optional isClear As Boolean = True) As Boolean

　ですから、後は、同じやり方で、SQLExecute()を書くだけ。これですと、文字列、日付、数字等の型でミスマッチが起きないように更新することも可能かと思います。（多分！？）更新先のシートにデータがある限りですが・・・。

　ともかく、NO.1さんの指摘のように、外部ブックや外部データベースは、Execute 一発で更新、挿入が出来るようです。ネット上のサンプルもそれしか発見できませんでいた。

　まあ、UPDATE、INSERT、DELETEって表を操作したら、それでいいじゃねーか。って、言われれば、それまで。だが、やり始めたことには決着を付けないと気が済まないタイプ。毎日が日曜日の70の爺の暇つぶしで、作業を続けたいと思います。

　多分、No1さん、No2さんの指摘の通りだと思います。回答、ありがとうございました。

補足

"MSDASQL"であれJetエンジンであれ、.Executeで全ての型を反映してUPDATEとINSERTしてくれるようです。でないと言うのは、私の無知ゆえの早とちりでした。ただ、DELETE文に関しては"MSDASQL"はサポートしていません。ですから、多分、Jetも。ともかく、DELETE文以外は、解決しました。しかし、"MSDASQL"とJETが動作するのになーんでて気はします。でも、これ以上、 "Microsoft.ACE.OLEDB.12.0"に拘るのは止めにして締め切ります。

回答No.3

HohoPapa

周知とは思いますが
>シートの列の型に応じて更新
列ごとに
int,float,string,date...といった型を保持、または強制する機能は
エクセルにはありません。

あくまで、利用者が
セルごとに表示形式を指定して使うことを想定しています。
そのため、
一般的なDB上のテーブルと同等の動作や命令を求めることには
無理が生じます。

お礼

甘かったですね。"MSDASQL"もJetエンジンも結果は同じでした。やっぱり、別の角度から攻めるしかないようです。頑張ります。

補足

ですね。エクセルは、どうやら表示形式に沿った型は保持しているようです。ですから、数字、文字列、日付、金額という型は取得できました。日付と時刻とが区別されているかは、未確認です。そういう事情で、クロス集計クエリ―とか差分クエリーの結果を吐き出す際には、それぞれの型に応じて決めた表示書式（記号定数）に従うしかありませんでした。

　それと、Jetエンジンについては、この型問題は解決しているかも知れません。ですから、先のお礼は、少々、私の早とちりです。

＞DB上のテーブルと同等の動作や命令を求めることには無理が生じます。

という思い込みでの先の回答は撤回しておきます。"MSDASQL"バージョンをテストした矢先でしたので、私もそう思い込んだ次第です。で、今夜中に、この思い込みを捨ててJetエンジンを試してみます。

　そういう意味での、補足です。成功したら、お礼を書かなきゃ―いけませんから・・・。

回答No.1

unokwave

恐らくですが、
>If Not Len(xlFileName) Then
　　　　 xlFileName = ThisWorkbook.FullName
　　End If
と
>.Open xlFileName
の組み合わせに問題があるように思えます。
多重オープンを許す共有向け排他制御をExcelでは記述しようがなく、現在開いているブックをコピーする事すらVBAの純粋Copy処理ではエラーになるくらいです。
起動中のインスタンスに対する操作ならともかく、自身のファイルに対する直接操作は許されないのではないかと思えます。

お礼

回答ありがとうございます。多分、質問者の回答で解決への第一歩が開けたと思います。ありがとうございます。なお、できましたら、本補足をお読みいただければ幸いです。

補足

【補足]】ErrMessage()が欠落していました。

　回答者が現象を再現・確認するには、ErrMessage()が必要ですので補足しておきます。また、.Provider = "MSDASQL"バージョンの全容も示しておきます。両者の違いは、

ReadOnly=False;

が明示的に指示されているかどうかです。で、試しに ADODB.Connection の 《.Mode = 3》を指示しても状況は改善されません。

Public Function MyExecute(ByVal strSQL As String, _
　　　　　　　　　　　　　 Optional xlFileName As String = "", _
　　　　　　　　　　　　　 Optional isHeader As Boolean = True) As Boolean
On Error GoTo Err_MyExecute
　　'
　　' 【要参照設定】
　　'
　　' Micrsoft ActiveX Data Objects 2.8 Library
　　'
　　Dim DataValue
　　Dim isOK　　　 As Boolean
　　Dim strHDR　　 AS String
　　Dim cnn　　　　As ADODB.Connection

　　isOK = True

　　Set cnn = New ADODB.Connection
　　'
　　' ThisWorkbook.FullName の指定
　　'
　　If Not Len(xlFileName) Then
　　　　 xlFileName = ThisWorkbook.FullName
　　End If
　　'
　　' 接続設定
　　'
　　With cnn
strHDR = IIf(isHeader, "HDR=YES", "HDR=NO")
　　　　.Provider = "MSDASQL"
.Properties("Extended Properties") = "Excel 12.0;" & strHDR & ";IMEX=1"
　　　　cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
　　　　　　　　　　　　　　　 "DBQ=" & xlFileName & ";" & _
　　　　　　　　　　　　　　　 "ReadOnly=False;"
　　　　.Open
　　　　.Execute strSQL
　　End With
Exit_MyExecute:
On Error Resume Next
　　cnn.Close
　　Set cnn = Nothing
　　MyExecute = isOK
　　Exit Function
Err_MyExecute:
　　isOK = False
　　If cnn.Errors.Count > 0 Then
　　　　ErrMessage cnn.Errors(0), strSQL
　　　　cnn.RollbackTrans
　　Else
　　　　MsgBox "プログラムエラーが発生しました。" & _
　　　　　　　 "システム管理者に報告して下さい。(MyExecute)", _
　　　　　　　 vbExclamation, " 関数エラーメッセージ"
　　End If
　　Resume Exit_MyExecute
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