アクセス ADO 並べ替え

質問

Public rsMain As New ADODB.Recordset
Public cn As New ADODB.Connection

Private Sub cmd_実行_Click()

Set cn = CurrentProject.Connection

rsMain.CursorLocation = adUseClient
rsMain.Open "Qクエリ", cn, adOpenStatic, adLockPessimistic
rsMain.Filter = "実行フラグ =-1"
rsMain.Sort = "順番 ASC"

としたときに

実行時エラー　-2147217824
並べ替えを適用できません。
となります。

実際QクエリはデザインビューでIFF関数で作った列を
並べ替え：昇順にしているのですが
ADOで取得した際はその並べ替え通りにはならないので
rsMain.Sortで並べ替えをしようと思ったのですがエラーになります。

どういう原因でこの実行時エラーが発生するのでしょうか？

回答No.1

山田 太郎（@f_a_007） · ベストアンサー

なるほど、不用意に.Sortを使うとエラーが出ますね。以下は、回答のために急造したテスト関数です。キモは、

　　　　　　.CursorLocation = adUseClient

の１行でした。

Public Function DBSelect(ByVal strQuerySQL As String, _
　　　　　　　　　　　　 Optional colDelimita As String = ";", _
　　　　　　　　　　　　 Optional rowDelimita As String = ";", _
　　　　　　　　　　　　 Optional strFilter As String = "", _
　　　　　　　　　　　　 Optional strSort As String = "") As String
On Error GoTo Err_DBSelect
　　Dim R　　　　　 As Integer ' 行インデックス
　　Dim N　　　　　 As Integer ' 行総数 - 1
　　Dim cnn　　　　 As ADODB.Connection
　　Dim rst　　　　 As ADODB.Recordset
　　Dim fld　　　　 As ADODB.Field
　　Dim strList　　 As String　' 全てのデータを区切子で連結して格納

　　Set cnn = CurrentProject.Connection
　　Set rst = New ADODB.Recordset
　　With rst
　　　　If Len(strSort) = 0 Then
　　　　　　.Open strQuerySQL, _
　　　　　　　　　cnn, _
　　　　　　　　　adOpenStatic, _
　　　　　　　　　adLockReadOnly
　　　　Else
　　　　　　' ※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
　　　　　　'
　　　　　　' CursorLocation = adUseClient　<--- 書かないとエラーになる！
　　　　　　'
　　　　　　' ※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
　　　　　　.CursorLocation = adUseClient
　　　　　　.Open strQuerySQL, _
　　　　　　　　　cnn, _
　　　　　　　　　adOpenKeyset, _
　　　　　　　　　adLockOptimistic
　　　　　　.Sort = strSort
　　　　　　Stop
　　　　End If
　　　　If Len(strFilter) Then
　　　　　　.Filter = strFilter
　　　　End If
　　　　If Not .BOF Then
　　　　　　N = .RecordCount - 1
　　　　　　.MoveFirst
　　　　　　For R = 0 To N
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　strList = strList & .Value & colDelimita
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　　　strList = Mid(strList, 1, Len(strList) - 1) & rowDelimita
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　Else
　　　　　　strList = ""
　　　　End If
　　End With
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = IIf(Len(strList) > 0, Replace(strList & "[END]", rowDelimita & "[END]", ""), "")
　　Exit Function
Err_DBSelect:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr(13) & Chr(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelect
End Function

お礼

ありがとうございました。