AccessVBA 現在開いているアクティブなテーブルクエリのフィールドのテキストとレコードを取得

これまでの記事

Access VBA Get CurrentTableDef 現在開いているテーブルを取得
Access　VBA GetCurrent Record on ActiveSheet カレントのテーブル/クエリ　からレコードセットを抜き出す

ここまではクエリからレコードセットを抜き出すことができませんでした。
今回は1行分ならクエリでもテーブルでも抜き出せます。
ポイントはDynasetではなくレコードクローンで全部抜いてMoveで該当行に移動する点です。

Access VBAのコード

Sub GetOpenTableQueryCurrentRecord()
Dim cDB As DAO.Database: Set cDB = CurrentDb
Dim Q As QueryDef
Dim fld As DAO.Field
Dim buf As String
Dim acCTRLs As Controls
Dim acObj As AccessObject
Dim acView
Dim acWIn
Dim acDataSheet
Dim acScr
Dim acControl
Dim dRsc As DAO.Recordset2
Dim dRs2 As DAO.Recordset2
Dim sbForm As Form
Dim i As Long
Const conNoActiveDatasheet = 2484
On Error GoTo GetSelection_Err
Set acScr = Application.Screen
Set acControl = acScr.ActiveControl
Set acDataSheet = Application.Screen.ActiveDatasheet
Set acView = Application.Screen.ActiveDatasheet.ActiveControl
buf = acView.Text
Debug.Print Application.CurrentObjectName 'カレントのオブジェクト名
Debug.Print acDataSheet.FormName 'カレントのテーブル/クエリ名
Debug.Print acDataSheet.Name 'カレントのクエリ/テーブル名
Debug.Print acView.Name 'カレントのフィールド名
Debug.Print acView.SelText 'カレントのフィールドのテキストのさらに選択しているテキスト
Debug.Print acView.Text 'カレントのフィールドのテキスト(文字列)
Debug.Print acView.Value 'カレントのフィールドの値
Debug.Print acView.Format 'カレントのフィールドの表示形式
Debug.Print "Recordcount:", acDataSheet.CurrentRecord 'カレントのレコードナンバー(行数)
Debug.Print acDataSheet.FilterOn 'テーブル/クエリにフィルタがかかっているか
Debug.Print "Row " & acDataSheet.SelTop '選択している最初のフィールドの上からの位置(行)
Debug.Print "Column " & acDataSheet.SelLeft '選択している最初のフィールドの左からの位置(列)

If Application.CurrentObjectType = acTable Then
Debug.Print "CurrentObject is Table(acTable = 0)"
ElseIf Application.CurrentObjectType = acQuery Then
Debug.Print "CurrentObject is Query(acQuery = 1)"
ElseIf Application.CurrentObjectType = acForm Then
Debug.Print "CurrentObject is Form(acForm = 2)"
ElseIf Application.CurrentObjectType = acReport Then
Debug.Print "CurrentObject is Report(acReport = 3)"
ElseIf Application.CurrentObjectType = acMacro Then
Debug.Print "CurrentObject is Access Action Macro(acMacro = 4)"
End If
Set dRs2 = acDataSheet.RecordsetClone 'カレントのフィールドがある全レコードを取得
If acDataSheet.SelTop = 0 Then Exit Sub
Debug.Print dRs2.RecordCount 'カレントのテーブルクエリの全レコード数(フィルターがかかっている場合はフィルターがかかった後のレコード数)
dRs2.MoveFirst
dRs2.Move acDataSheet.CurrentRecord - 1
'For i = 1 To acDataSheet.CurrentRecord - 1
'dRs2.MoveNext
'Next i
Stop
For i = 0 To dRs2.Fields.Count - 1
Debug.Print dRs2.Fields(i).Name, dRs2.Fields(i).Value
Next i
dRs2.Move acDataSheet.SelTop - 1


With CreateObject("Scripting.FileSystemObject")
If .FolderExists(buf) = True Then
With CreateObject("WScript.Shell")
.Run "%WinDir%\Explorer.exe " & """""" & buf & """"", 1, False"
End With
Else
Exit Sub
End If
End With
GetSelection_Bye:
Exit Sub
GetSelection_Err:
Debug.Print Err.Number, Err.Description
If Err.Number = conNoActiveDatasheet Then

MsgBox "No data sheet is active.", vbExclamation
Resume GetSelection_Bye
End If
End Sub

その他

バックアップ

Accessで必ず使うVBA ほぼ完全なエクスポート 全オブジェクト+参照設定リストをエクスポート

フィルターの操作

Access VBA Accessで必ず使う 今表示されているテーブル、クエリのフィルターを解除する
Access VBA 名前が同じテーブルにフィルターをかけて開き データを抜き出してまとめてファイルにする