DAOで取得したデータがExcel上に吐かれない？！
いつも参考にさせて頂いています。
このサイトでのサンプルを改造しながら、サイトで調べながら・・・と「ながら」業務が多い今日この頃。
現在、VB(DAO)でデータ抽出(Excelより)し、その結果を新たなExcelに吐き出す処理を作成しておったのですが、
どうも、吐き出す際のレコードオブジェクトのポインタ移動に問題ありな現象になっています。（以下にソースを掲載）
このソースを実行すると、生成したExcelブックの先頭シートに抽出レコード数分 データが吐かれているのですが、
吐かれてる内容が一番最初のデータ(抽出元の１行目に見出しを記載しているので、その内容）が 39523件吐かれてし
まいます。ちゃんと、レコードセットオブジェクトをMoveNextしているのですが・・・どこに落ち度があるのでしょうか。
ご指摘お願い致します。
Private Sub Command1_Click()
Dim db As DAO.Database 'データベースオブジェクト
Dim rs As DAO.Recordset 'レコードセットオブジェクト
Dim sFile As String '参照するデータファイル
Dim sSQL As String 'データ抽出SQL
Dim xlsApp As Excel.Application 'Excelオブジェクト
Dim xlsBook As Excel.Workbook 'ブックオブジェクト
Dim xlsSheet As Excel.Worksheet 'シートオブジェクト
Dim iRow As Integer 'iRow...新しいシートに書き込む行変数
Dim iCol As Integer 'iCol...新しいシートに書き込む列変数
On Error GoTo OpenException
sSQL = "SELECT " & _
" '項目1' " & _
" ,'項目2' " & _
" ,'項目3' " & _
" ,'項目4' " & _
" ,'項目5' " & _
" ,'項目6' " & _
"FROM [TEST_DATA$]"
sFile = "\\123.456.789\APL\base.xls"
Set db = DBEngine.Workspaces(0).OpenDatabase(sFile, False, False, "Excel 8.0;HDR=NO;")
' Set db = DBEngine.Workspaces(0).OpenDatabase(sFile, False, False, "Excel 8.0;HDR=YES;")
Set rs = db.OpenRecordset(sSQL)
' rs.MoveLast
' MsgBox rs.RecordCount '取得したレコード数確認(39523件 正常取得)
On Error GoTo CreateException
'---------------------------------
' 新しいExcelのオブジェクト生成
'---------------------------------
Set xlsApp = CreateObject("Excel.Application")
Set xlsBook = xlsApp.Workbooks.Add
Set xlsSheet = xlsBook.Worksheets(1)
xlsApp.Visible = True
iRow = 1
rs.MoveFirst
'---------------------------------
' 生成したExcelの最初のシートに
' 抽出データを吐き出す
'---------------------------------
Do Until rs.EOF
For iCol = 1 To 6
'---▽ 【記載方法１】吐き出しデータ⇒×
' xlsBook.ActiveSheet.Cells(iRow, 1).Value = rs.Fields(0)
' xlsBook.ActiveSheet.Cells(iRow, 2).Value = rs.Fields(1)
' xlsBook.ActiveSheet.Cells(iRow, 3).Value = rs.Fields(2)
' xlsBook.ActiveSheet.Cells(iRow, 4).Value = rs.Fields(3)
' xlsBook.ActiveSheet.Cells(iRow, 5).Value = rs.Fields(4)
' xlsBook.ActiveSheet.Cells(iRow, 6).Value = rs.Fields(5)
'---△
'---▽ 【記載方法２】吐き出しデータ⇒×
xlsBook.ActiveSheet.Cells(iRow, iCol).Value = rs.Fields(iCol - 1).Value
'---△
'---▽ 【記載方法３】吐き出しデータ⇒×
' xlsBook.Worksheets(1).Cells(iRow, iCol).Value = rs.Fields(iCol - 1).Value
'---△
Next iCol
iRow = iRow + 1 '吐き出し行のインクリメント
rs.MoveNext 'ポインタ移動
Loop
MsgBox "----- データ吐き出し完了 -----"
'後処理：Excel関連のオブジェクト破棄
xlsApp.Quit
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
'後処理：DAO関連のオブジェクト破棄
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
Exit Sub
'---------------------------------
' DAOに関する処理のException
'---------------------------------
OpenException:
MsgBox (Err.Number & " " & Err.Description)
'---------------------------------
' Excel制御に関する処理のException
'---------------------------------
CreateException:
MsgBox (Err.Number & " " & Err.Description)
End Sub
> 現在、VB(DAO)でデータ抽出(Excelより)し、その結果を新たなExcelに
> 吐き出す処理を作成しておったのですが、
あれ?
Excel をオートメーション操作しているのであれば、わざわざ DAO を
経由せずとも、WorksheetまたはRangeの内容自体を別のWorkbookに
複写してやるだけで済むかと思いますけれども。
> どこに落ち度があるのでしょうか。
以下、こちらでは試していません(机上デバッグです)が…参考になれば。
> sSQL = "SELECT " & _
> " '項目1' " & _
> " ,'項目2' " & _
> " ,'項目3' " & _
> " ,'項目4' " & _
> " ,'項目5' " & _
> " ,'項目6' " & _
> "FROM [TEST_DATA$]"
それぞれの項目を、「'」で囲っていますよね。
これだと、項目の内容ではなく、「"項目1〜6" という文字列」が
全ての行に対して返されてしまいませんか?
> rs.MoveFirst
不要な気がします。0件の時に、エラーになるかも。
> xlsBook.ActiveSheet.Cells(iRow, iCol).Value = rs.Fields(iCol - 1).Value
> xlsBook.Worksheets(1).Cells(iRow, iCol).Value = rs.Fields(iCol - 1).Value
折角 xlsSheet という変数を用意したのですから、それを使いましょう。
それと、ループ中で WorksheetオブジェクトのCellsプロパティに
繰り返しアクセスするのは、効率が悪いと思います。Cellsプロパティを
Range型変数にキャッシュして、それを利用するようにするか、または
xlsSheet.Range(範囲).Value = 2次元配列
の構文を利用した方が、処理が高速化するかと。
| ツイート |  |