抽出結果を任意のブックの新規シートとして追加する。
Sub 外部ブックへ書き込み() Dim myCon As New ADODB.Connection, myRS As New ADODB.Recordset Dim DataBook As String, ReportBook As String, i As Integer Dim myCmd As String, tmpDate1 As Date, tmpDate2 As Date, tmpStr As String '抽出対象のブック DataBook = ThisWorkbook.Path & "\xls\DataBook.xls" '書き込み用のブック ReportBook = ThisWorkbook.Path & "\xls\ReportBook.xls" '抽出対象のブックに接続 myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;" & _ "Data Source=" & DataBook For i = 1 To 12 'Excelブックに書き込むためのSQL文字列を作成 tmpStr = "[Excel 8.0;DATABASE=" & ReportBook & "].[" & CStr(i) & "月データ]" '対象日付 tmpDate1 = DateSerial(2004, i, 1) tmpDate2 = DateSerial(2004, i + 1, 1) '実行するコマンドSQL myCmd = "SELECT * INTO " & tmpStr & " FROM [伝票一覧$] " & _ "WHERE 受注日>= #" & tmpDate1 & "# AND 受注日< #" & tmpDate2 & "#;" 'SQL文を実行 myCon.Execute myCmd Next myCon.Close: Set myCon = Nothing End Sub
「DataBook.xls」の「伝票一覧シート」の内容を各月ごとに「ReportBook.xls」の新規シート「1月」〜「12月」に書き出す。
Sub 新規データ追加2() 'Excelブックにシートを追加するひな形パターン Dim myCon As New ADODB.Connection, myRS As New ADODB.Recordset, FileName As String Dim myCmd As String, ReportBook As String '転記元ファイル FileName = ThisWorkbook.Path & "\xls\DataBook.xls" myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;" & _ "Data Source=" & DataBook '転記先ファイル名 ReportBook = ThisWorkbook.Path & "\xls\転記先-社員.xls" '名前つき範囲「社員」を新規シートに転記するコマンドSQL myCmd = "SELECT * INTO [Excel 8.0;DATABASE=" & ReportBook & "].[社員転記] FROM [社員]" 'SQL文を実行 myCon.Execute myCmd myCon.Close: Set myCon = Nothing End Sub
「DataBook.xls」
の名前付き範囲「社員」の内容すべてを、新規シート「転記先-社員.xls」の新規シート「社員転記」に書き出す。
名前つき範囲「社員」
実行結果
JetやSQLServerでは、SQL文内でSELECT命令とINTO句を組み合わせて使用することで動的にテーブル作成が可能。このSQL文をExcelに利用すると、任意のExcelファイルに対して、動的にテーブルの代わりにシートを作成できる。
同名のシートに注意
ADOを使用してINTO句を組み合わせたSELECT命令を持つSQL文を実行し、新規シートを追加する際に、すでに同名のシートが存在している場合はエラーとなる。
転記先として指定したExcelブックが存在しない場合には、新規ブックを作成し、そこにシートを追加していく。
SQL文を使用して転記されたデータは、「Recordsetオブジェクトを利用してCopyFromRecordsetメソッドを使用して転記」されたデータと比較するとフィールド名やフィールド情報も一緒に転記される点が異なる。