ExcelVBAにて外部データ（*.csv）をＳＱＬ文を使って抽出する方法

質問

こんにちは

ＶＢＡインポート問題で日々悩んでいるものです。

CSV形式のデータをODBCのシステムDSNに登録し、それをＤＡＯでＳＱＬ要求しデータを抽出する方法がよくわかりません。

（1）データベースの定義記述内容
（2）レコードセットにSQL命令をかける記述
（3）抽出された内容をワークシートに貼る記述

等がよくわかりません。

DAOの場合、レコードセットを定義するのに
set DB=DBEngine.OpenDatabase("******")があったり、なかったりする理由がわかりません。

突然、set rs = CurrentDb.OpenRecordset("*****")
しているのはなぜでしょうか。

回答No.2

TAGOSAKU7

ODBCじゃなきゃダメですか？
DAOで普通にCSVファイルに接続できるので、その方法のサンプルを載せておきます。

※注意点１．普通はRs.Recordcountとするとレコード件数がわかりますが、テキストに接続した場合はRs.Recordcountは常に[1]を返します。

※注意点２．DB名／テーブル名はテキストの場合は扱いが特別です。
たとえば
[c:\test.mdb] ← DB名
[TBL_商品] ← TABLE名
こういった扱いが普通ですが、テキストファイルの場合は
c:\Folder1\dmy\test.csvを分解して
[c:\Folder1\dmy\] ← DB名
[test#csv] ← TABLE名
となります。
注意すべきはテーブル名は、ピリオドが含む場合シャープ記号に変換して使用することです。

注意点３．GetRowsメソッドを使うとレコードセットのポインタが破棄されるため、使用不可能です。

当然ですが、ツールの参照設定で
[Microsoft Excel x.0 Object Library]
[Microsoft DAO x.x Object Library]
を指定してくださいね

Sub Main()
　　'CSVファイルのフルパス（任意です）
　　Const FileFullPath　As String = "c:\Folder1\dmy\test.csv"

　　'エクセルに貼り付ける時の開始行（任意です）
　　Const lngPasteRow　 As Long = 2

　　Dim Ws As　　　 DAO.Workspace
　　Dim Db As　　　 DAO.Database
　　Dim Rs As　　　 DAO.Recordset
　　Dim strSQL As　 String

　　Dim strDbName　 As String
　　Dim strTblName　As String

　　Dim xlsApp　　　As Excel.Application
　　Dim xlsBook　　 As Excel.Workbook
　　Dim xlsSheet　　As Excel.Worksheet

　　Dim i　 As Long
　　Dim j　 As Long

　　Dim cntFld　As Long

　　'DB名とTABLE名を取得する
　　Call getDbTbl_for_File(FileFullPath, strDbName, strTblName)

　　'テーブルオープン
　　Set Ws = DBEngine.Workspaces(0)
　　Set Db = Ws.OpenDatabase(strDbName, True, False, "Text;")
　　strSQL = "select * from [" & strTblName & "] where Field1='hoge'"
　　Set Rs = Db.OpenRecordset(strSQL)

　　'エクセル起動
　　Set xlsApp = New Excel.Application
　　Set xlsBook = xlsApp.Workbooks.Add
　　Set xlsSheet = xlsBook.Worksheets(1)
　　xlsApp.Visible = True

　　'書き込み
　　With xlsSheet
　　　　'フィールド数取得
　　　　cntFld = Rs.Fields.Count

　　　　'フィールド名の書き込み
　　　　For i = 0 To cntFld - 1
　　　　　　.Cells(lngPasteRow, i + 1).Value = Rs.Fields(i).Name
　　　　Next i

　　　　'各値の書き込み
　　　　i = 0
　　　　Do Until Rs.EOF
　　　　　　For j = 0 To cntFld - 1
　　　　　　　　.Cells(lngPasteRow + 1 + i, j + 1).Value = Rs(j).Value
　　　　　　Next j
　　　　　　i = i + 1
　　　　　　Rs.MoveNext
　　　　Loop
　　End With

　　xlsBook.Saved = True　　'更新情報を破棄する(閉じるときの「保存しますか？」のダイアログを表示させない)
　　Set xlsSheet = Nothing
　　Set xlsBook = Nothing
　　Set xlsApp = Nothing

　　Rs.Close
　　Db.Close
　　Ws.Close
　　Set Rs = Nothing
　　Set Db = Nothing
　　Set Ws = Nothing

End Sub

'テキストのファイルパスを分解して、データベース名(パス)とテーブル名(ファイル名)に分ける。
Private Sub getDbTbl_for_File(inFilepath As String, outDbName As String, outTblName As String)
　　Dim wkVal　 As Variant
　　wkVal = Split(inFilepath, "\")
　　outTblName = wkVal(UBound(wkVal))

　　outDbName = Left(inFilepath, Len(inFilepath) - Len(outTblName))
　　outTblName = Replace(outTblName, ".", "#")
End Sub

お礼

ありがとうございます。

実際に試してみます。
わからないことがありましたら補足に追加いたしますので
よろしくおねがいします。

補足

まだ試してませんが、

細かいことですが、ひとつ確認させていただきます。

'エクセル起動
　　Set xlsApp = New Excel.Application
上記の記述ですと、VBAでなくて、VBからの実行ということになるのでしょうか。
希望としましては、VBAからの実行をしたいのですが。