エクセルからAccessのIDでを検出させセル指定で抜き出し

質問

お世話になります
可能かどうかも分からず質問します。
一般的にはAccessからエクセルへインポートとなるのですが
便利上Access、DBをIDで検出させ、必要な列だけセル指定でエクセルにインポートしたいのですが、エクセル側から可能ですか？
又、方法、関連サイトなどありましたら宜しくお願いします。

回答No.6

KenKen_SP

VBE でユーザーフォームを挿入し、そこへ TextBox1 と CommandButton1
を配置して、下記コードをコピペします。

前回との違いを見比べて見て下さい。そうすれば、入力のインターフェース
がセル→フォームに変わったことによる違いや、一括ボンの方法ではなく、
ループさせてひとつひとつセルに転記させていく手法の雰囲気がわかると
思います。

参考URL:
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_130_030.html

んで、、、すみません。今回はエディタに直接入力したのと、動作確認用
のサンプル DB をつくる時間がなかったので、実際に Excel での動作確認
をとってません。多分大丈夫だと思いますが、エラーがでたらすみません。

Private Const CONNECTION_STR = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="

' // 参照設定した場合は以下の定数宣言は不要
Private Const adOpenKeyset = 1
Private Const adLockReadOnly = 1

' // CommandButton1 クリックイベント
Private Sub CommandButton1_Click()

　　Dim Cn　　　 As Object ' ADODB.Connection
　　Dim Rs　　　 As Object ' ADODB.Recordset
　　Dim Col　　　As Object ' ADODB.Field
　　Dim lCode　　As Long
　　Dim sMdbPath As String
　　Dim sSql　　 As String
　　Dim r　　　　As Long
　　Dim c　　　　As Long

　　' // 問い合わせる ID コードを取得（※ ID フィールドは長整数型と仮定）
　　If IsNumeric(TextBox1.Text) Then
　　　 ' // 少数などがあれば切り捨てる
　　　 lCode = CLng(Int(TextBox1.Text))
　　Else
　　　 MsgBox "整数値で入力すべし", vbCritical
　　　 Exit Sub
　　End If

　　' // DB へのパス生成(要修正）
　　sMdbPath = "MDBへのフルパス"
　　' // データ転記開始行(要修正）
　　r = 3

　　' // データ抽出の SQL を生成(要修正）
　　' // 抽出データが必ず１件であると断定できる場合、データの
　　' // ソートが必要ない場合は、ORDER BY ～ は不要
　　sSql = ""
　　sSql = sSql & "SELECT ID ,列名1,列名2,列名3,列名4,列名5"
　　sSql = sSql & " FROM フォーム名かクエリ名"
　　sSql = sSql & " WHERE ID=" & CStr(lCode)
　　sSql = sSql & " ORDER BY ID"
　　' // SQL 文のデバッグ用コードです。通常時はコメントアウト
　　' Debug.Print sSql

　　' // データベースに接続
　　Set Cn = CreateObject("ADODB.Connection")
　　Cn.Open CONNECTION_STR & sMdbPath

　　' // データ抽出(今回は取得が目的なので読み取り専用）
　　Set Rs = CreateObject("ADODB.Recordset")
　　Rs.Open sSql, Cn, adOpenKeyset, adLockReadOnly

　　' // 転記先セルの初期化
　　Rows("3:" & CStr(Rows.Count)).ClearContents

　　' // データ抽出できたか？
　　If Rs.EOF And Rs.BOF Then
　　　　' // 該当データがなかった場合
　　　　MsgBox "該当データがありません", vbCritical
　　Else
　　　　' // 該当データがあった場合
　　　　Rs.MoveFirst
　　　　Do Until Rs.EOF
　　　　　　c = 0
　　　　　　For Each Col In Rs.Fields
　　　　　　　　c = c + 1
　　　　　　　　Cells(r, c).Value = Col.Value
　　　　　　Next Col
　　　　　　r = r + 1
　　　　　　Rs.MoveNext
　　　　Loop
　　End If

　　' // オブジェクトを開放
　　Rs.Close: Set Rs = Nothing
　　Cn.Close: Set Cn = Nothing

End Sub

お礼

粘り強く初心者にお相手して頂き
段階を踏んだ、ご指導等まことにありがとうございます。

補足

お世話になります
教えて頂いた物は一行に対して一行おきに貼り付ける又は貼り付ける列数などと理解いたしました。

やはりIDを検索させ列名1はA1へ、列名2はB2へ、列名3はF1へ見たいな指定が望ましいのですがだめですか？
一括ポンはがいいのですがなにか分けがあるのでしょうか？

エラーもなく動作はスムーズにいきます。