こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

【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のテーブル:テストテーブル
からデータを取得するように変更したいのですが、
どのようにコーディングすればよろしいでしょうか?

よろしくお願いします。

投稿日時 - 2008-06-24 09:34:48

QNo.4124984

すぐに回答ほしいです

質問者が選んだベストアンサー

[イミディエイト]
? 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

投稿日時 - 2008-06-24 15:50:21

お礼

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

投稿日時 - 2008-06-24 16:36:12

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

  Dim I      As Integer
  Dim J      As Integer

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

投稿日時 - 2008-06-24 09:56:56

顧客マスタ:

顧客番号__顧客名_____読み
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

投稿日時 - 2008-06-24 09:54:25

お礼

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

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

投稿日時 - 2008-06-24 14:58:45

あなたにオススメの質問