Accessのデータシート形式で表示させているクエリのレコードやフィールド、セルを選択、値を取得する方法

Function ExportActiveQuerySelect()
'DoCmd.RunCommand acCmdOutputToText
'DoCmd.RunCommand acCmdOutputToExcel
'今開いているクエリがデータシートビューなら、オプションで定められている
'既定のフォルダ(オプションを変更しない限り出力時は変更できない）にクエリ名で出力。
'同名のファイルは警告なしで上書き。
'行でセレクトしている状態なら、その行、または全体を
'列で選択しているならその列を
'個別のセルを選択している状態ならそのセルのみを出力する
Dim cDB As DAO.Database: Set cDB = CurrentDb
Dim Q As QueryDef, QTgt() As QueryDef
Dim acChild, acObj As AccessObject, acObjName As String
Dim cnt As Long
Dim acScr As Screen, oAcDataSheet 'As DataSheet
Dim rs2 As Recordset2, rs As Recordset, strFilter As String, Qdef As QueryDef, Qtmp As QueryDef
Dim iType As Long
Dim iCol As Long, irow As Long
Dim sSQL As String
Dim i As Long
Dim buf As String, str As String
iType = Application.CurrentObjectType 'まずActiveなものがクエリかどうかオブジェクトのタイプを取得
If iType <> acQuery Then GoTo Terminator ' Query Only
acObjName = Application.CurrentObjectName
Set acObj = Application.CurrentData.AllQueries(acObjName)
Set acScr = Application.Screen
Set acChild = acScr.ActiveControl
If acObj.CurrentView <> acCurViewDatasheet Then GoTo Terminator 'Datasheetview only
Set Qdef = cDB.QueryDefs(acObjName)
'DoCmd.RunCommand acCmdSelectRecord 'これを入れると必ずアクティブな1行全体になる,フィールド(列)全体を選択していると強制的に1行目が選択される。
DoCmd.RunCommand acCmdOutputToText '文字コードを選ぶ画面が出て、それを選ぶと出力される。Windows標準かUNICODEかUTF-8を選択
DoCmd.RunCommand acCmdOutputToExcel
Exit Function
Finally:
Exit Function
Terminator:
If Err.Number <> 0 Then
Debug.Print Err.Number, Err.Description
Err.Clear: Resume Finally
Else
Exit Function
End If
End Function

Access VBA Get CurrentTableDef 現在開いているテーブルを取得
これをクエリにしたもの。
フォーカスしているものがないとエラーになります。
選択の仕方はできるネットを参照してください。
Accessのテーブルでレコードやフィールド、セルを選択する方法

データシートビューで特定のセルを選択(フォーカス)するには、白い十字のマウスポインターでセルをクリック、または、ドラッグします。マウスポインターの形をよく見て操作しましょう。

1. 選択クエリを作り、データシート形式で表示します。デザインビューではエラーになります。
   
2. 現在フォーカスしている行、列(フィールド)を取得して出力します。フォーカスがない場合はエラーになります。
   
3. VBAではテーブルやクエリの左端は0番というのは有名ですが、この場合はちゃんと1番から始まります。
   
4. テキスト、Xlsxは既定のフォルダにクエリの名前で出力され、既存のファイルがある場合は警告なしで上書きされます。
   
5. テキストは出力前に文字コードを選択できます。
   
6. 1つまたは連続するセルフォーカスして、編集可能な状態ではない場合、そのフォーカスしたセルのみ出力します。
   
   • 1つのセルにフォーカスして編集可能な状態にすると、クエリ全体を出力。
   • 列(フィールド)を選ぶとその列を出力
   • 1行の左端の□をクリックして行を選ぶと、その行全体を出力。
   • クエリのカーソルの状態で、列全体、1行、アクティブな行列の１つの値と変わります。
   • ただしDoCmd.RunCommand acCmdSelectRecordのコメントを外して有効にすると、強制的にフォーカスしている行全体になります。またフィール(列)を選択している場合、強制的に1行目を選択に変わります。
   • これを有効にするのもデータシートが何十列もない場合は有効です。
   
   

   実際にやってみる

   テーブルの概要(ADO講座の流用)

   ID 売上日 社員名 性別 売上額
   6 2004/01/23 橘修平 男性 52100
   1 2004/07/29 草薙良子 女性 120310
   4 2004/04/30 中村静子 女性 785100
   9 2004/04/30 田中邦子 女性 4789210

   テーブルの設計

   ID カウンター オートナンバー
   F001売上日 日付型 空白許容 固有の値でなくてよい インデックスではない
   F002社員名 テキスト(10字)　日付型 空白許容 固有の値でなくてよい インデックスではない
   F003性別(10字)　日付型 空白許容 固有の値でなくてよい インデックスではない
   F004売上額 通貨型　日付型 空白許容 固有の値でなくてよい インデックスではない
   CREATE TABLE T_Sample;

   Sub make_Sampletbl()
   Dim cDB As DAO.Database: Set cDB = CurrentDb
   Dim Q As QueryDef, Tbl As TableDef
   Dim fld As DAO.Field, dRs As DAO.Recordset
   Dim sSQL As String, LineCnt As Long
   Dim ar, iar As Long
   '半角空白区切り
   ar = Split("2004/01/23 橘修平 男性 52100 2004/07/29 草薙良子 女性 120310 2004/04/30 中村静子 女性 785100 2004/04/30 田中邦子 女性 4789210", " ")
   ’テーブル作成アクションクエリ文字列
   sSQL = "CREATE TABLE [T_Sample] (ID COUNTER PRIMARY KEY,F001売上日 Date,F002社員名 Char(10),F003性別 Text(10),F004売上額 Currency);"
   DoCmd.RunSQL sSQL 'クエリを実行してテーブルを作成(同名のテーブルがある場合エラー)
   Application.RefreshDatabaseWindow 'これをかませて作成
   Set Tbl = cDB.TableDefs("T_Sample") '作ったテーブルをオブジェクトにして
   Set dRs = cDB.OpenRecordset(Tbl.Name) 'Dao.Recordsetを開く
   LineCnt = 1 '4行
   iar = LBound(ar) ’配列の最初
   Do While LineCnt < 5
   dRs.AddNew
   dRs.Fields(1).Value = CDate(ar(iar)): iar = iar + 1
   dRs.Fields(2).Value = ar(iar): iar = iar + 1
   dRs.Fields(3).Value = ar(iar): iar = iar + 1
   dRs.Fields(4).Value = Ccur(ar(iar)): iar = iar + 1
   dRs.Update
   LineCnt = LineCnt + 1
   Loop
   End Sub
   

   

   売り上げが50万以上ある人

   

   "SELECT * FROM T_Sample WHERE (((T_Sample.F004売上額)>500000));"

   Sub make_Sampletbl()
   Dim cDB As DAO.Database: Set cDB = CurrentDb
   Dim Q As QueryDef, Tbl As TableDef
   Dim fld As DAO.Field, dRs As DAO.Recordset
   Dim sSQL As String, LineCnt As Long
   Dim ar, iar As Long
   ar = Split("2004/01/23 橘修平 男性 52100 2004/07/29 草薙良子 女性 120310 2004/04/30 中村静子 女性 785100 2004/04/30 田中邦子 女性 4789210", " ")
   On Error Resume Next
   DoCmd.RunSQL "Drop Table [T_Sample];"
   DoCmd.DeleteObject acQuery, "QS_Tsample500KOver"
   If Err.Number <> 0 Then Err.Clear
   On Error GoTo 0
   sSQL = "CREATE TABLE [T_Sample] (ID COUNTER PRIMARY KEY,F001売上日 Date,F002社員名 Char(10),F003性別 Text(10),F004売上額 Currency);"
   DoCmd.RunSQL sSQL
   Application.RefreshDatabaseWindow
   Set Tbl = cDB.TableDefs("T_Sample")
   Set dRs = cDB.OpenRecordset(Tbl.Name)
   LineCnt = 1
   iar = LBound(ar)
   Do While LineCnt < 5
   dRs.AddNew
   dRs.Fields(1).Value = CDate(ar(iar)): iar = iar + 1
   dRs.Fields(2).Value = ar(iar): iar = iar + 1
   dRs.Fields(3).Value = ar(iar): iar = iar + 1
   dRs.Fields(4).Value = ar(iar): iar = iar + 1
   dRs.Update
   LineCnt = LineCnt + 1
   Loop
   Application.RefreshDatabaseWindow
   Set Q = cDB.CreateQueryDef("QS_Tsample500KOver", "SELECT * FROM T_Sample WHERE (((T_Sample.F004売上額)>500000));")
   
   DoCmd.OpenQuery Q.Name, acViewNormal 'クエリをデータシートビューで開きます
   
   End Sub
   
   

   2列選択

   

   
   

   このVBAの特徴

   選択クエリをExcelにExportするVBAがこちらです。
   これはそもそも選択クエリを表示させることなく一気にExcelに出力し、かつxls(Excel97),xlsx(2010、2013以降のxlsx)の２つに出すというものです。

   Exportする例

   呼び出し側

   このようにクエリ名を指定してCallします。

   Sub callExpotSpredsheetVBA()
   Call ExportSpredSheetVBA("QS_Tsample500KOver")
   End Sub
   

   本体

   ExportSpredSheetVBA

   
   '-----------------ExportSpredSheetVBA
   
   Public Sub ExportSpredSheetVBA(QueryName As String)
   '選択クエリをCurrentDBのパス/フォルダにエクスポート
   'xls,xlsx形式を両方出力する
   ' xlsに出力する場合には少なくとも、レコード数が65,535以下であること(最初の1行目がタイトル行になるため最大より1少ない)
   Dim destFileName As String
   Dim dt As Date: dt = Now() '重複を避けるため、タイムスタンプを取得して後に文字列化する
   'ファイル名の生成
   destFileName = CurrentProject.Path & "\" & QueryName & Format(dt, "yyyymmddHHMMss") & ".xlsx"
   If Dir(destFileName) <> "" Then Kill destFileName
   DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, QueryName, destFileName, True
   'ファイル名の生成
   destFileName = CurrentProject.Path & "\" & QueryName & Format(dt, "yyyymmddHHMMss") & ".xls"
   If Dir(destFileName) <> "" Then Kill destFileName
   DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, QueryName, destFileName, True
   End Sub
   

   上記と比較すると次のような長所がある

   全部取得してしまいExcelを見るまで成否がわからない

   xportSpredSheetVBA(QueryName As String)も強力です。しかし、クエリを見て出力できません。
   また完全に自分が欲しいデータだけ出力できるとは限りません。
   目視等で取る方が確実な場合があります。

   完全に絞り切らなくていい

   多少余計なデータやフィールドがあっても、隣り合ってさえいれば取得できます。

   絞り切らなくていいため、新たにクエリの作成、フォーム、レポートの作成がいらない

   オプションで既定のフォルダを変更しないと、Dbのあるフォルダに出力できないが、その分早い。手っ取り早くデータが欲しいという時にSQLを考えたりする必要がない
   また、ファイル名や形式が選べないだけでクエリのXlsx変換もできます。

   参考

   DoCmd メソッド (Access)
   AcCommand 列挙 (アクセス)
   DoCmd.TransferSpreadsheet
   AcDataTransferType 列挙
   AcSpreadSheetType