[[20131001231029]]　『DBから取得したデータをExcelシートに出力したい』（れい）　ページの最後に飛ぶ

『DBから取得したデータをExcelシートに出力したい』（れい）

Excel2010,WIN7です。
DB接続し、取得したデータを他のシートにペーストして保存するプログラムを
作成しています。
ただ、実行すると「インデックスが有効範囲にありません」と表示され、うまく動きません。
レコードセットの使い方に問題があるのでしょうか。
わかる方、ご教示の程よろしくお願い致します。

Sub 出力()

    Dim con As New ADODB.Connection
    Dim connectionString As String
    Dim q, cid, que As String
    Dim cmd,As ADODB.Command
    Dim rs0 As New ADODB.recordset

    Dim sDBSever, As String
    Dim sDBName, As String
    Dim sLoginID, As String
    Dim sPassWD, As String

    sDBSever = "aaa"
    sDBName = "db"
    sLoginID = "ID"
    sPassWD = "pass"

    Set cmd = New ADODB.Command

    '接続文字列
    connectionString = "Provider=Sqloledb;Data Source=" & sDBSever _
    & ";Initial Catalog=" & sDBName _
    & ";Connect Timeout=30" _
    & ";user id=" & sLoginID _
    & ";password=" & sPassWD _
    & ""

    On Error GoTo Err_DBConnectOpen

    'DB接続
    con.Open connectionString
    con.CursorLocation = 3
    cmd.ActiveConnection = con
    cmd.CommandTimeout = 100

    cid = Cells(12, 7).Value
    Dim workname As String
    Dim j As Long

    For j = 3 To 5
      q = ""
      que = ""
      q = Cells(4, j).Value
      que = Replace(q, "#{tikan}", cid)

      cmd.CommandText = que
      Set rs0 = cmd.Execute

      Workbooks.Add
      workname = ActiveWorkbook.Name
      Workbooks(workname).Sheets(1).Range("A1").CopyFromRecordset rs0

      '取得したデータをワークブックに書き出しで保存
      Application.DisplayAlerts = False
      Workbooks(workname).SaveAs Filename:=ThisWorkbook.Path &  "test.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
        Application.DisplayAlerts = True

        rs0.Close
        Set rs0 = Nothing
        Workbooks(workname).Close

    Next

    'エラー処理
Err_DBConnectOpen:
    MsgBox Err.Description

    'Connectionの状態を確認し、クローズ
    If con.State <> ADODB.adStateClosed Then
        con.Close
    End If
    Set con = Nothing

End Sub

 どこでエラーが出ているかを書いてもらった方が良いと思いますが、
 エラーが出ているのが
        Workbooks(workname).Close
 であるなら、
        Workbooks(workname).SaveAs 
 で名前を変えてしまっているからでしょう。

 名前で管理するのではなく、オブジェクトで管理すればそういったことは
 手間がかからないと思います。

 Dim wb As Workbook
 Set wb =  Workbooks.Add()
 wb.Sheets(1).Range("A1").CopyFromRecordset rs0
    :
 wb.SaveAs ....
    :
 wb.Close

 のように。
 (Mook)

Mook様

まさしく！ご名答です。
指摘頂いた箇所の修正で無事動きました。
ありがとうございます。

(れい)

コメント返信：

[ 一覧(最新更新順) ]

[[20131001231029]] 『DBから取得したデータをExcelシートに出力したい』（れい） ページの最後に飛ぶ

[[20131001231029]]　『DBから取得したデータをExcelシートに出力したい』（れい）　ページの最後に飛ぶ