【EXCEL VBA】ローカルmdbからデータを取得したい

質問

（環境）
　WindowsXP
　Excel2003
　Access2003

現在、SQLサーバーからデータを取得しています。
下記のソースです（一部抜粋）

Private Const SRC_SQL = "Provider=SQLOLEDB.1;User ID=testid;Password=testpass;Data Source=TEST-DB-1;Initial Catalog=testDB"
Private Const TBL_TEST = "TEST.テストテーブル"

Public Sub　TEST_PRO

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Set cn = CreateObject("ADODB.Connection")
cn.CommandTimeout = 0
cn.Open SRC_SQL

strSQL = "SELECT X.*, FROM " & TBL_TEST & " X"
strSQL = strSQL & " WHERE X.担当者CD = '" & wNAME & "'"
strSQL = strSQL & " AND X.オープン日 >= '" & start_dt & "'"
strSQL = strSQL & " AND X.オープン日 < '" & end_dt & "'"
strSQL = strSQL & " ORDER BY X.オープン日 ASC"

Set rs = CreateObject("ADODB.Recordset")
rs.Open strSQL, cn

With rs

～～～

End With

Set rs = Nothing

End Sub

これを、SQLサーバーではなく、
C:\TESTACCESS.mdbのテーブル：テストテーブル
からデータを取得するように変更したいのですが、
どのようにコーディングすればよろしいでしょうか？

よろしくお願いします。

回答No.3

noname#140971 · ベストアンサー

[イミディエイト]
? DBSelect("SELECT * FROM 顧客マスタ")
0001;鈴木 一郎;すずき いちろう;
0002;中村 主水;なかむら もんど;

エラートラップを消して、CreateObject()を使用する手法に変更。
そうすると、以下のようになります。

With Rst～End With を・・・にすれば。

Public Function DBSelect(ByVal strQuerySQL As String, _
　　　　　　　　　　　　　Optional Separator As String = vbCrLf) As String
　　Dim R　　　　　 As Integer
　　Dim M　　　　　 As Integer
　　Dim rst　　　　 As Object
　　Dim fld　　　　 As Object
　　Dim strList　　 As String

　　Set rst = CreateObject("ADODB.Recordset")
　　With rst
　　　　・・・
　　End With
　　rst.Close
　　Set rst = Nothing
　　DBSelect = strList
End Function

ただ、これだけのコード。

Public Const pubCNNSTRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Temp\DB8.mdb"

Public Function DBSelect(ByVal strQuerySQL As String, _
　　　　　　　　　　　　　Optional Separator As String = vbCrLf) As String
　　Dim R　　　　　 As Integer
　　Dim M　　　　　 As Integer
　　Dim rst　　　　 As Object
　　Dim fld　　　　 As Object
　　Dim strList　　 As String

　　Set rst = CreateObject("ADODB.Recordset")
　　With rst
　　　　 .Open strQuerySQL, _
　　　　　　　 pubCNNSTRING, _
　　　　　　　 3, _
　　　　　　　 1
　　　　 If Not .BOF Then
　　　　　　M = .RecordCount - 1
　　　　　　.MoveFirst
　　　　　　For R = 0 To M
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　strList = strList & fld.Value & "" & ";"
　　　　　　　　Next fld
　　　　　　　　strList = strList & Separator
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　 Else
　　　　　　strList = ""
　　　　 End If
　　End With
　　rst.Close
　　Set rst = Nothing
　　DBSelect = strList
End Function

お礼

何度もご回答いただき、ありがとうございました。
参考にさせていただきます。

回答No.2

noname#140971

Dim I　　　　　 As Integer
　　Dim J　　　　　 As Integer

は不要！
急遽、回答のために作成したもの。
所々にゴミがあります。

回答No.1

noname#140971

顧客マスタ:

顧客番号__顧客名_____読み
0001______鈴木 一郎__すずき いちろう
0002______中村 主水__なかむら もんど

[イミディエイト]
? DBSelect("SELECT * FROM 顧客マスタ")
0001;鈴木 一郎;すずき いちろう;
0002;中村 主水;なかむら もんど;

次は、C:\Temp\DB8.mdb のデータをエクセルのイミディエイトに取得・表示するサンプルコードです。
要は、接続文字列を以下のようにするだけかと思います。

Public Const pubCNNSTRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Temp\DB8.mdb"

Public Function DBSelect(ByVal strQuerySQL As String, _
　　　　　　　　　　　　　Optional Separator As String = vbCrLf) As String
On Error GoTo Err_DBSelect
　　Dim I　　　　　 As Integer
　　Dim J　　　　　 As Integer
　　Dim R　　　　　 As Integer
　　Dim M　　　　　 As Integer
　　Dim rst　　　　 As ADODB.Recordset
　　Dim fld　　　　 As ADODB.Field
　　Dim strList　　 As String

　　Set rst = New ADODB.Recordset

　　With rst
　　　　 .Open strQuerySQL, _
　　　　　　　 pubCNNSTRING, _
　　　　　　　 adOpenStatic, _
　　　　　　　 adLockReadOnly
　　　　 If Not .BOF Then
　　　　　　M = .RecordCount - 1
　　　　　　.MoveFirst
　　　　　　For R = 0 To M
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　strList = strList & fld.Value & "" & ";"
　　　　　　　　Next fld
　　　　　　　　strList = strList & Separator
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　 Else
　　　　　　strList = ""
　　　　 End If
　　End With
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = strList
　　Exit Function
Err_DBSelect:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelect
End Function

お礼

早速のご回答、ありがとうございます。

すみません、正直なところ私にはきちんと理解できないのです、、、。
私の書いたソースで修正箇所を記入していただけると助かるのですが、、、。
よろしくお願いします。