[Excel ADO]テキストとシートの混在使用法

質問

Excel2007を使っています。

ADOを使ったSQL処理をやっているのですが、
元データ（テーブル）をCSVファイルと、エクセルのシートの両方を使うことはできますか？

例えば、商品コード表とか担当者コード表みたいな比較的小規模かつ動きの少ないものはエクセルシート上の表を参照し、CSVファイルの売上データを処理する、というようなイメージです

小さなテーブルのファイルが増えていくのがイヤで、ひとつのブック内に集約しておけないものでしょうか

回答No.3

mitarashi

#1です。
Accessの無い環境で使用するには下記をインストールする必要がありそうです。

Microsoft Access データベース エンジン 2010 再頒布可能コンポーネント
http://www.microsoft.com/ja-jp/download/details.aspx?id=13255

2007向けは下記かもしれません。
2007 Office system ドライバ: データ接続コンポーネント
https://www.microsoft.com/ja-jp/download/details.aspx?id=23734

ご参考まで。

回答No.2

mitarashi

#1です。
http://okwave.jp/qa/q9079324.html
で嘘をつく結果になってしまいましたが、ワークシート間を結合したクエリは実行可能です。
本質問の#1の回答の、CSVにリンクしたワークシートと、他のワークシート間を結合したクエリも同様に実行できますので、この場をお借りして補足させていただきます。
本題と外れて申し訳ありませんが、12万行のデータから、1000件の値に合致するものを別ワークシートに抽出する課題の実行時間計測結果の一部です。
CSVにリンクしたワークシートに適用すると、Jet4.0はエラーになりました(深く追求して無いです)。ご参考まで。
方法 msec
AutoFilter一括(Criteriaに配列指定） 265
ワークシート間で内部結合クエリ(Jet4.0) xlsm形式 655
ワークシート間で内部結合クエリ(ace12.0) xlsm形式 2090
重複対応連想配列 2605
AdvancedFilter一括 29391
両リストをVariant配列に取込み照合（一括貼付） 30467
Find&FindNextを1000回実行 217887
ワークシートでADO(key毎にSELECT文1000回実行） 1539792

お礼

返事が遅くなり申し訳ございません。

なかなか難解なお話で、まだ全容がつかめておりませんが、
MSのリンク先等も読んでみた限り、
Access DBをHUBにして、CSV、Excelブック、シート他を
リンクすることができる、という感じでしょうか。
私の環境にはAccessがないのでどうなるか気がかりですが、
明日にでも実証実験をやってみたいと思います。

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

回答No.1

mitarashi

二種類の接続からのクエリという意味でしたら、色々検索してみましたが発見できませんでした。
案１：外部データの取込でワークシートにCSVを接続。売上データのCSVをいつも同じ場所、名前で置けば、手動更新もしくはオープン時に自動更新可。（いちいちファイルの在処を聞いて来ない設定可）
案２：エクセルからアクセスのDBを生成、CSVやエクセルワークシートをリンクテーブルに設定。複数リンクテーブル間のクエリを実行。このDBは中味が無い様なものなので、使用都度生成・削除しても軽いと予想。
案1が現実的ですが、個人的興味だけで案2をやってみました。文字数オーバーでコメント等消さざるを得ませんでしたが、ご参考まで。
' 参照設定:Microsoft ADO Ext,Active Data Objects Library
Sub createLinkedXLws()
Dim accdbPath As String
Dim xlwsPath As String, mySheetName As String
Dim csvPath As String, csvFileName As String
Dim destRange As Range
Dim objCn As ADODB.Connection
Dim objRS As ADODB.Recordset
Dim strSQL As String

On Error GoTo errHandle
accdbPath = GetDesktopPath & "\test.accdb"
xlwsPath = ThisWorkbook.FullName
csvPath = GetDesktopPath
csvFileName = "社員情報.csv"
mySheetName = "社員マスタ"
If makeAccDB(accdbPath) <> 0 Then
Err.Raise 1001, , "create accdb error"
End If
If Not checkFile(xlwsPath) Then Exit Sub
'自ブックへのリンク
If CreateLinkedExternalTable( _
accdbPath, _
"Excel 12.0 Xml;DATABASE=" & xlwsPath & ";HDR=YES", mySheetName & "$", mySheetName) <> 0 Then
Err.Raise 1002, , "worksheet link error"
End If
' CSVへのリンク
If CreateLinkedExternalTable( _
accdbPath, _
"text;DATABASE=" & csvPath & ";HDR=YES; FMT=Delimited;", csvFileName, getBaseName(csvFileName)) Then
Err.Range 1003, , "csv link error"
End If
Set destRange = ThisWorkbook.Sheets("Sheet1").Range("A1")
Set objCn = New ADODB.Connection
With objCn
.Provider = "Microsoft.ace.OLEDB.12.0"
.ConnectionString = "Data Source=" & accdbPath
.Open
End With
strSQL = "SELECT A.社員コード, A.氏名, B.記事 FROM 社員マスタ AS A INNER JOIN 社員情報 AS B ON A.社員コード = B.社員コード;"
Set objRS = New ADODB.Recordset
Set objRS = objCn.Execute(strSQL)
pasteFieldNames objRS, destRange
destRange.Offset(1, 0).CopyFromRecordset objRS
errHandle:
If Err.Number <> 0 Then MsgBox Err.Number & " : " & Err.Description
On Error GoTo 0
On Error Resume Next
If Not objRS Is Nothing Then objRS.Close
Set objRS = Nothing
If Not objCn Is Nothing Then objCn.Close
Set objCn = Nothing
End Sub

Sub pasteFieldNames(rs As ADODB.Recordset, destCell As Range)
Dim i As Long

For i = 0 To rs.Fields.Count - 1
destCell.Offset(, i).Value = rs.Fields(i).Name
Next i
End Sub

'https://msdn.microsoft.com/ja-jp/library/cc376276.aspxから借用・改造
Function CreateLinkedExternalTable(strTargetDB As String, _
strProviderString As String, _
strSourceTbl As String, _
strLinkTblName As String) As Boolean

Dim catDB As ADOX.Catalog
Dim tblLink As ADOX.Table

On Error GoTo errHandle
Set catDB = New ADOX.Catalog
catDB.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strTargetDB
Set tblLink = New ADOX.Table
With tblLink
.Name = strLinkTblName
Set .ParentCatalog = catDB
.Properties("Jet OLEDB:Create Link") = True
.Properties("Jet OLEDB:Link Provider String") = strProviderString
.Properties("Jet OLEDB:Remote Table Name") = strSourceTbl
End With
catDB.Tables.Append tblLink
Set catDB = Nothing
errHandle:
CreateLinkedExternalTable = Err.Number
End Function

Function makeAccDB(accdbFullPath As String) As Long
Dim cat As ADOX.Catalog
Dim ConnectionString As String

On Error GoTo errHandle
Set cat = New ADOX.Catalog
ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
cat.Create ConnectionString & accdbFullPath & ";"
Set cat = Nothing
errHandle:
makeAccDB = Err.Number
End Function

Function getBaseName(fileFullPath As String) As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
getBaseName = FSO.getBaseName(fileFullPath)
Set FSO = Nothing
End Function

Private Function GetDesktopPath() As String
'デスクトップのパスを取得する関数。文字数制限から割愛。
End Function