VBA Recordset の Sort でエラーになる

Question

Excel VBA のRecordset でSort でエラーが出て実行できない

下記コードで .Sort でエラーとなり困っています

.Sort の行をコメントアウトすると問題なく実行できます。
（2時間ほどはまって困っております…）
間違っている個所をご指摘頂きたいと思いますのでどうぞよろしくお願いいたします。

Excel VBA

Sub Connection()
    Dim con As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    
    Const strFileName = "DB.accdb"
    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName & ";"
    
    rs.CursorLocation = adUseClient
    Set rs = con.Execute("select * from Q_DB")
    
    With rs    
        .Sort = "Gr"
        .Filter = "Gr >= 1"
    End With
    
    ActiveCell.CopyFromRecordset rs

    rs.Close
    con.Close
    Set rs = Nothing
End Sub

Answer 1

私もよくわかってないのですみませんが、

rs.CursorLocation = adUseClient
の１行を
Set rs = con.Execute("select * from Q_DB")
の次に入れ替えるか、

もしくは
Withの中に、
「.CursorLocation = adUseClient」として、
「.Sort」の前にもってきたら、

エラーにならないのではないでしょうか？

ダメだったらすみません。

※ご参考URL（Excelのですみませんが・・・）
https://excelwork.info/excel/adosort/

Comments

[shigeru]

ダメでした・・・
エラー
「オブジェクトが開いている場合は、操作は許可されません。」となりました。

[komugi3333]

大変申し訳ございません。
変数宣言で「NEW」してるので「SET=・・・」は要らなかったんですね。気が付いていませんでした。すみません。
なので、ご質問のコードのように「SET」の前に「rs.CursorLocation = adUseClient」を書くこと自体は間違っていなかったのですね。

当方でも（mdbですみませんが）少しテストをしてみましたら、「.CursorLocation = adUseClient」をExceuteのあとにやると、おっしゃるとおり、「オブジェクトが開いている場合は、操作は許可されません。」とエラーになりました。

でも、ということは、「Con」のほうの「Open」のほうは、ご質問のコードで間違ってないということになる気がします。

また、ADOのヘルプを読んでみましたら、「Sourceプロパティ」でSQLを使えるようですから、次のようにしてみたらどうなりますでしょうか？

Sub Connection()
　　Dim con As New ADODB.Connection
　　Dim rs As New ADODB.Recordset

　　Const strFileName = "DB.accdb"
　　con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName & ";"

'　　rs.CursorLocation = adUseClient
'　　Set rs = con.Execute("select * from Q_DB")

　　'レコードセットのプロパティの設定
　　With rs
　　　　.Source = "select * from Q_DB"
　　　　.CursorLocation = adUseClient
　　　　.ActiveConnection = con
　　　　.Sort = "Gr"
　　　　.Filter = "Gr >= 1"
　　End With

　　'レコードセットを開く（Withのなかでやればいいのですが）
　　rs.Open

　　ActiveCell.CopyFromRecordset rs

　　rs.Close
　　con.Close
　　Set rs = Nothing
End Sub

ちなみにですが、（当方では覗きに行くファイルがmdbしか作れなかったのでmdbですみませんが）、以下のコードで「D:\1\tes001.mdb」の「Sheet1」というテーブルのレコードが、並べ替えもフィルタも適用された状態で、Excelのシートに吸い込まれました。

Sub test01()

　　Dim con As New ADODB.Connection
　　Dim rs As New ADODB.Recordset

'　　'変数宣言でNEWすると、このSetが要らないっぽいです。
'　　'Newをつけてないときは必要｡
'　　Set con = New ADODB.Connection

　　con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\1\tes001.mdb;"

'　　'変数宣言でNEWすると、このSetが要らないっぽいです。
'　　'Newをつけてないときは必要｡
'　　Set rs = New ADODB.Recordset

　　'レコードセット自体はNEWですでにできているっぽいので、
　　'Openする前に各プロパティを設定する。
　　'SQLはExceuteする以外に、
　　'.Sourceプロパティで設定しても良いっぽいです。
　　With rs
　　　　.Source = "select * from Sheet1;"
　　　　.ActiveConnection = con
　　　　.CursorLocation = adUseClient
　　　　.Sort = "金額 DESC"
　　　　.Filter = "金額 >= 15000"
　　End With

　　'※ ADOのヘルプには、
　　'『Source プロパティには、Command オブジェクト変数、
　　'SQL ステートメント、ストアド プロシージャ、
　　'またはテーブル名を設定できます。』とありました。

　　'「.CursorLocation = adUseClient」
　　'を、Openした後に実行すると、当方も
　　'「オブジェクトが開いている場合は、操作は許可されません。」
　　'となりました。Excelも同じかもしれません。
　　'ので、SortなどもまとめてOpenやの前にやったほうが
　　'いいのかもしれません。

　　'レコードセットを開く（Withの中でやってもいいのですが）
　　rs.Open

　　ActiveCell.CopyFromRecordset rs

　　rs.Close
　　con.Close
　　Set rs = Nothing

End Sub

[komugi3333]

ごめんなさい。
　　'「.CursorLocation = adUseClient」
　　'を、Openした後に実行すると、当方も
　　'「オブジェクトが開いている場合は、操作は許可されません。」
　　'となりました。Excelも同じかもしれません。
　　'ので、SortなどもまとめてOpenやの前にやったほうが
　　'いいのかもしれません。
は
　　'「.CursorLocation = adUseClient」
　　'を、Openした後に実行すると、当方も
　　'「オブジェクトが開いている場合は、操作は許可されません。」
　　'となりました。
　　'Exceuteも同じかもしれませんので、
　　'SortなどはまとめてOpenやExceuteの前にやったほうが
　　'いいのかもしれません。

の誤りでした。

[komugi3333]

何度もすみません。

最初のコードのほうは

'　　rs.CursorLocation = adUseClient
'　　Set rs = con.Execute("select * from Q_DB")

の2行は不要なのでコメントアウトしてあります。

[komugi3333]

結局、最初の回答された方と同じこと言ってるだけでした。申し訳ございませんでした。

[shigeru]

ご丁寧にありがとうございます。
下記のｺｰﾄﾞで試してみましたが、やはりOpen でエラーとなります。
こうなるとｺｰﾄﾞの問題ではなく、Access側のﾃﾞｰﾀと何らかの関係があるのでしょうか・・・
ただ、下の二つ目に記載しましたｺｰﾄﾞだと問題なく取込みができています。

Sub Openでエラーとなるｺｰﾄﾞ()

Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset

' Connection Open
Const strFileName = "確定DB.accdb"
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName & ";"

With rs
.Source = "select * from Q_DB;"
.ActiveConnection = con
.CursorLocation = adUseClient

.Sort = "Gr"
.Filter = "Gr >= 1"
.Filter = "年月 >= 201804"
.Open
End With

ActiveCell.CopyFromRecordset rs, , 20

rs.Close
con.Close
Set rs = Nothing

End Sub
-----------------------------------------------------------------

下記のｺｰﾄﾞは問題なく取り込めます。

Sub 実行可能なｺｰﾄﾞ()

Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset

' Connection Open
Const strFileName = "確定DB.accdb"
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName & ";"

Set rs = con.Execute("select * from Q_DB ORDER BY Gr,年月")

With rs
.Filter = "Gr >= 1"
.Filter = "年月 >= 201804"
End With

ActiveCell.CopyFromRecordset rs, , 20

rs.Close
con.Close
Set rs = Nothing
End Sub

[komugi3333]

すみません！お恥ずかしながら、私もプログラミング初心者レベルなので詳しいことはわからないのですが・・・・

エラーメッセージの内容が最初のご回答をされたかたの時と同じでしたら、そのメッセージでGoogle検索してみましたら、日付型のフィールドの話や、以下のようなお話が出てきました。

https://blog.wakisaka-tsuyoshi.com/2013/03/adodbefail.html

ここには
.CursorLocation = adUseClient
を
.CursorLocation = adUseServer
に変えるとうまくいったとあります。
一度試してみてはいかがでしょうか？

あと、
https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/open-method-ado-recordset?view=sql-server-2017
に、ADOの「Recordsetの」Openのヘルプがありますので、カーソルタイプ？のこととかも関係あるのかもしれません。

adUseServerやadUseClientなど、「CursorLocationEnum」についてはこちらに説明がありました。
https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/cursorlocationenum?view=sql-server-2017

ヘルプはなかなか意味の把握がむずかしいですが、質問を作るときなどにもヒントになるかもしれません。

もともと、
「Connectionオブジェクト」用のメソッドの「Execute」と
「Recordsetオブジェクト」用のメソッドの「Open」
という違いもありますので、その２つの違いも調べる必要が恐らくですが、あるのではないかという気がします。

大した回答ができずにすみません。

[shigeru]

色々と調べて頂きましてありがとうございました。じっくり一つ一つ調べてみる必要がありそうですね。とても助かりました！

[komugi3333]

「ado recordset sort vba」でGoogle検索して、
https://tonari-it.com/excel-vba-access-recordset-sort/#toc5
がヒットしたので見てみましたら

.CursorLocation = adUseClient
は
Openの前にやらないといけないっぽいですが、
Sort
はOpenのあとにやってもいいようです。
こちらのテストでも（またもやmdbですみませんが）大丈夫でした。
FilterもOpenのあとで大丈夫でした。

なので、

With rs
.Source = "select * from Q_DB;"
.ActiveConnection = con
.CursorLocation = adUseClient
.Open
.Sort = "Gr"
.Filter = "Gr >= 1"
.Filter = "年月 >= 201804"
End With

とOpenをWithの中の中間地点にもってきたらどうなるでしょうか？

なので、

ActiveCell.CopyFromRecordset rs, , 20

の直前にやったらエラーはどうなりますでしょうか？

Sortだけ

[komugi3333]

Sortのヘルプのコードもそうなっていました。
https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/sort-property-example-vb?view=sql-server-2017

[shigeru]

ようやく下記のコードでSort が実行できましたのでご報告いたします。
結果から言いますと、すいません・・・
　Q_DB のデータに「#Num」のエラーデータが入っていたことが原因でした。
　教えて頂いたサイトを参考に.Sortの行を変えてみたり、試したのですが実行できなかったので、データ側の問題を疑い、対象のSource（テーブルやクエリ）を色々と変えて検証しました。すると問題なく実行できるケースがあることが分かり、データの[#Num]が原因であることにたどり着きました。
　また因みにですが、Accessのクエリ側で[ Like "*2" ] などワイルドカードを使っていると、コードは問題なく実行できるのですが取得レコード数が０件になってしまうことが分かりました(Access側のクエリはシンプルにしておいた方がよさそうです…）
　.Sort は　.Open の前後どちらでも実行可能でした^^
コードの質問をしていたにも関わらずデータ側の問題があり申し訳ありませんでした・・・。

Sub ようやく解決()

Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset

Const strFileName = "DB.accdb"
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName & ";"

With rs
.Source = "select * from Q_DB;"
.ActiveConnection = con
.CursorLocation = adUseClient

.Filter = "Gr >= 1"
.Filter = "年月 >= 201804"
.Sort = "Gr"
.Open
End With

ActiveCell.Offset(1).CopyFromRecordset rs, , 20

rs.Close
con.Close
Set rs = Nothing
End Sub

[komugi3333]

わ！良かったですね！！
私もほんとう、まだちゃんと色々わかってないので・・・
そのくせ回答などしてしまい・・・

でもほんとうによかったです。

お話をお聞きして、なるほど～と思いました。
逆に私も勉強になりました。ありがとうございました。^^

Answer 2

Accessがある環境にてサンプルを作成し実行してわかったこと。

Sortのプロパティは使えない仕様である。

Sub test1()
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim strProvider As String
    Dim strDataSource As String
    Dim strSQL As String
    
    
    Set cnn = CreateObject("ADODB.Connection")
    strProvider = "Provider=Microsoft.ACE.OLEDB.12.0;"
    strDataSource = "Data Source=C:\DATA\Access\db1.accdb;"
    cnn.Open strProvider & strDataSource
    
    Set rst = New ADODB.Recordset
    With rst
        .CursorLocation = adUseServer
        .CursorType = adOpenForwardOnly
        .LockType = adLockReadOnly
'        .Sort = "[f1]"
        .Filter = "f3='日本'"
    End With
    
    rst.Open "select * from qry_SampleData1", cnn, , , adCmdText
    
    Application.ActiveCell.CopyFromRecordset rst
    
    rst.Close
    Set rst = Nothing
    cnn.Close
    Set cnn = Nothing
    
End Sub

これで、.Sortプロパティをコメントアウトするとすんなり実行できます。
外さず実行すると、
「実行時エラー '3251'　現在のプロバイダー並べ替え、またはフィルタリングに必要なインターフェイスをサポートしていません。」と素直にメッセージボックスっが表示されます。
ということは、もともと使えない機能を使おうとしていることです。

並べ替えは、Access側で事項するか、Excelにデータを代入した後に、ExcelのSortメソッドで実行するかの２択だと思います。

Comments

[shigeru]

私も最初は Access VBA が可能でExcel VBA では使用できないのかと思ったのですが、複数のサイト上にExcel VBA で紹介されているので実行可能かと思いました。

Answer 3

    rs.CursorLocation = adUseClient
    Set rs = con.Execute("select * from Q_DB")

という順番が気になりますね。con.Executeで新しいRecordSetオブジェクトが返されているんじゃないでしょうか。

上記2行を消して

    With rs    
        .Source = "Q_DB"
        .CursorLocation = adUseClient
        .Sort = "Gr"
        .Filter = "Gr >= 1"
        .Open
    End With

とかしてみては。

Comments

[shigeru]

ありがとうございます。記載いただいたｺｰﾄﾞで .Sort 行は実行できました。しかし、.Open 行でエラー「この操作を実行するために接続を実行できません。このコンテキストで閉じているかあるいは無効です。」となりました。

[kabao]

あら失礼。Withの中に
.ActiveConnection = con
も必要かもしれません。

[shigeru]

入れてみましたら違う .Open 実行でエラーが返ってきました。
「データプロバイダーまたはほかのサービスが E_FAIL 状態を返しました。」初めて見るエラーです・・・。

[kabao]

Errオブジェクトや、con.Errorsから、詳細な理由が取得できるかもしれません。

Answer 4

Set rs = con.Execute("select * from Q_DB")
のSQL文にソートと抽出条件をつけ足せばいいのではと思います。

Set rs = con.Execute("select * from Q_DB as a where a.Gr>=1 order by a.Gr")

Accessが無いのでテストはしていないのですが、この程度でしたら、SQL文に全部条件を入れた方が良いと思います。

Comments

[shigeru]

おっしゃる通りＳＱＬ文でやってしまえばいいのですが、実際にはこんないにシンプルな抽出条件ではないため Recordset で実行したいと思っています。

[Nor-Xor]

今質問と回答を眺めていて感じたことを書きます。
私も最初、Recordsetの並び替えや抽出で悩みまくりました。
何をどういうふうに抽出したいのかがわからないので確定的なことは書けませんが、私は条件からSQLを自動生成するプログラムを別で組んで、パラメータ渡しだけで済むようにしました。
最終的にはSQLのコマンドを勉強したら驚くほど短い命令で済むことが多く、自力で作ったほうが速いしムダがないことがわかるのですが。