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

こんにちは

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

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

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

等がよくわかりません。

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

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

No.1 回答者： ARC 回答日時： 2001/10/30 03:39

とりあえず後半部分だけにお答えします。

前半部分については、他の方にお任せ(^^;
(解答がつかなければ、補足とかで催促してください。)


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

いわゆる「オブジェクト指向」ってやつが関係しています。
まず、OpenRecordsetっていうのは、Databaseオブジェクトに対して、レコードセットを作成せよって命令なのです。

顧客DBと売上DBの二つのデータベースがあるとして、
Dim DB_Kokyaku As DAO.Database 'Database型の変数を宣言する
Dim DB_Uriage As DAO.Database

Dim RS_Kokyaku As DAO.Recordset 'Recordset型の変数を宣言
Dim RS_Uriage as DAO.Recordset



Set DB_Kokyaku = DBEngine.OpenDatabase("顧客DB")
Set DB_Uriage = DBEngine.OpenDatabase("売上DB")

Set RS_Kokyaku = DB_Kokyaku.OpenRecordset("顧客テーブル")
Set RS_Uriage = DB_Uriage.OpenRecordset("売上テーブル")

RS_Kokyaku.MoveLast
Msgbox "顧客テーブルの件数は" & RS_Kokyaku.RecordCount & "件です。"

RS_Uriage.MoveLast
Msgbox "売上テーブルの件数は" & RS_Uriage.RecordCount & "件です。"

上記のコードを読めば、Set DB =… の意義がわかっていただけると思います。

でも、一々、Database型の変数を宣言して、Set DB = としてデータベースを開くなんて、メンドクサイですよね。開きたいテーブル/クエリ/SQLは「今使ってるデータベース」の中にあるのに…

そこで CurrentDBメソッドの登場。
CurrentDBはAccessに最初から組み込まれている関数で、
「Access ウィンドウで現在開かれているデータベース (Databaseオブジェクト) のオブジェクト変数を返します。」(ヘルプより)

つまり、CurrentDB.なんたら とするのは

Dim DB As Database
Set DB = OpenDatabase("現在Accessで開いているDBの名前")
DB.なんたら

とするのと同じです。加えて動作も高速ですしね。
ってことで、普段はCurrentDBの方を使っとけばいいんです。
で、現在Accessで開いていないDBを使うときだけ、
Set DB = …
としてやればいいと。

この回答へのお礼

毎度お世話になっております。

まだ、試しておりませんが使わせていただきます。

お礼日時：2001/10/30 06:51

No.2 回答者： TAGOSAKU7 回答日時： 2001/10/30 04:14

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からの実行をしたいのですが。

補足日時：2001/10/30 06:46

この回答へのお礼

ありがとうございます。

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

お礼日時：2001/10/30 06:37

No.3 回答者： TAGOSAKU7 回答日時： 2001/10/30 09:56

>　　Set xlsApp = New Excel.Application

?上記の記述ですと、VBAでなくて、VBからの実行ということになるのでしょうか。
?希望としましては、VBAからの実行をしたいのですが。

ＶＢＡで大丈夫ですよ。(^^;)
何らかのモジュールを開いて、ツールの参照設定で
[Microsoft Excel x.0 Object Library]
を指定したらアクセスからエクセルを操作できます。

ちなみにWord/PowerPointを参照設定してたら、それらのソフトを操作することもできますよ。これはＶＢもＶＢＡも一緒です。


ステップ実行してみてください。
コメントがプログラムに書いてあると思いますが、処理としては
１．ＣＳＶファイルのフルパスから、ＤＢ名とＴＡＢＬＥ名を取得
２．ＤＢ（ファイルパスのディレクトリ）／ＴＡＢＬＥ（ＣＳＶファイル）に接続
３．エクセルの起動
４．テーブルのフィールド名を、エクセルに出力
５．各フィールドの持つ値を、エクセルに出力
っていう感じです。


もしかして、hoomaさんの考えている処理は、クエリを作成して、ＤｏＣｍｄ（アクセスの持ってる命令）でエクセル形式でエクスポートしたいのですか？

この回答への補足

お世話になってます。
実行したら下記のエラーがでました。

実行時エラー'3061':
ラメータが少なすぎます。１を指定してください。

変更した点は
Const FileFullPath As String = "c:\db4\0110itmz.csv"
です。

なにか、足りないのでしょうか。

＞もしかして、hoomaさんの考えている処理は、クエリを作成して、
＞ＤｏＣｍｄ（アクセスの持ってる命令）でエクセル形式でエクスポートしたいのですか？

今のところ、SQLでできればクエリは必要ないです。

補足日時：2001/10/30 14:18

この回答へのお礼

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

ＶＢＡの参照設定でＤＡＯ　のバージョンが違ったためエラーになりましたが、正しいものに変えてCSVデータのインポートができるようになりました。
しかし、途中で値がオーバーフローになってしまい完全にインポートできません。99レコード目でいつも止まります。
さらに、速度が遅いんですが、速くはならないのでしょうか。
いろいろお願いしてすみません。

お礼日時：2001/10/30 19:30

No.4 ベストアンサー 回答者： TAGOSAKU7 回答日時： 2001/10/31 06:27

田吾作７＠３８．６度の風邪引きです。

。。
返事が遅くなってすいません。昨日ほとんど寝てました。。。


作りなおしました。

質問の仕様が
１．ODBC
２．EXCELに貼り付け

とあったので、すでにODBCは無視してますが、EXCELに貼り付けは忠実に守ろうとしていました。
今回のは、完全に仕様を無視したつくりになってます。（スピード重視のため）

作りとしては
１．CSVのデータをAccessにテーブルとして取り込む
２．EXCEL形式でエクスポート＆ワークブックを開く

もしこれでもいいのであれば、こちらの方が処理が早いと思います。


Sub Main2()
　　'CSVファイルのフルパス
　　Const csvFullPath　 As String = "c:\Folder1\dmy\test.csv"
　　'EXCELファイルのパス
　　Const excelFullPath As String = "c:\test.xls"
　　'ＣＳＶファイルを取り込むテーブル名
　　Const DmyTbl　　　　As String = "DmyTbl"
　　
　　
　　'CSVファイルを取り込む
　　Call inCsv(csvFullPath, DmyTbl)
　　
　　'EXCEL形式でエクスポート
　　Call outExcel(DmyTbl, excelFullPath)
End Sub

Private Sub outExcel(inTblName As String, inXlsFile As String)
　　Dim xlsApp　　　As Excel.Application
　　Dim xlsBook　　 As Excel.Workbook
　　
　　'エクセル形式でエクスポート
　　DoCmd.TransferSpreadsheet acExport, 8, inTblName, inXlsFile, True
　　
　　
　　'エクセル起動をしてエクスポートされたかを確認
　　Set xlsApp = New Excel.Application
　　Set xlsBook = xlsApp.Workbooks.Open(inXlsFile)
　　
　　xlsBook.Worksheets(inTblName).Select
　　
　　xlsApp.Visible = True

　　Set xlsBook = Nothing
　　Set xlsApp = Nothing
End Sub
Private Sub inCsv(inFileName As String, inTblName As String)
　　Dim Db　　　As DAO.Database
　　Dim strSQL　As String
　　
　　Dim strFile As String
　　Dim strPath As String
　　
　　Dim wkVal　 As Variant
　　
　　Set Db = CurrentDb
　　
　　'とりあえずダミーを削除
　　On Error Resume Next
　　Db.TableDefs.Delete inTblName
　　On Error GoTo 0
　　
　　'パスとファイル名に分解
　　wkVal = Split(inFileName, "\")
　　strFile = wkVal(UBound(wkVal))
　　strPath = Left(inFileName, Len(inFileName) - Len(strFile))
　　
　　'SQL文（テーブル作成用）を作成
　　strSQL = "select * into " & inTblName & _
　　　　　　" from " & "[Text;DATABASE=" & strPath & "].[" & strFile & "]"
　　Db.Execute strSQL
　　
　　Set Db = Nothing
End Sub

この回答へのお礼

お体大丈夫ですか。
今まで、いろいろとアドバイスいただきほんとうにありがとうございます。
参考にさせていただきます。
また、わからないことがありましたらお助けください。
本件の質問はこれで終了させていただきます。

お礼日時：2001/10/31 21:50