抽出結果を任意のブックの新規シートとして追加する。
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メソッドを使用して転記」されたデータと比較するとフィールド名やフィールド情報も一緒に転記される点が異なる。
