EXCEL→Access ADO接続

質問

お世話になります
現在ADOにてEXCEL側からAccessDBにアクセスし
値を取得しているのですが
現在下方向に貼り付けしているのですが
横方向に貼り付けさせる方法はありますか？
下記参考（現状VBAです）
現状：日付で絞込みをしています
日付け絞込みをしてヒットしたものに対して下方向に貼り付けています
それを横方向に貼り付けさせたいのです

Private Sub CommandButton1_Click()

Dim myConn As ADODB.Connection
Dim myRs As ADODB.Recordset
Dim mySQL As String
Dim myConstr As String
Dim myDBFName As String
Dim myPswd As String
Dim tableName As String
Dim orderDate As String
Dim shipDate As String

orderDate = Format(DateValue(DTPicker1.Value), "mm/dd/yyyy")
shipDate = Format(DateValue(DTPicker2.Value), "mm/dd/yyyy")

myDBFName = "Accessパス"
myPswd = ""
myConstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& myDBFName & ";Jet OLEDB:Database Password=" & myPswd & ";"

mySQL =SQL文

Set myConn = New ADODB.Connection
myConn.Open myConstr
Set myRs = New ADODB.Recordset
myRs.Open mySQL, myConn
Worksheets("シート名").Range("開始セル名").CopyFromRecordset myRs
myRs.Close
Set myRs = Nothing
myConn.Close
Set myConn = Nothing
Unload Me
End Sub

わかる方ご教授願います

回答No.8

noname#140971

その他のコードは、書き換える必要はありません
これは、私が示したコードのことです。

Const 開始行 = 1
Const 開始列 = 1

Private Sub CommandButton1_Click()
　　Dim I　　　　　　　As Integer
　　Dim N　　　　　　　As Integer
　　Dim strEmployees() As String

　　strEmployees() = Split(DBSelect("質問者のSQL文"), ";")
　　N = UBound(strEmployees()) - 1
　　For I = 0 To N
　　　　Me.Cells(開始行, 開始列 + I) = strEmployees(I)
　　Next I
End Sub

これで、開始行の開始列から横にデータを表示します。
コピぺ方式だと縦に自動表示されます。
そういうエクセルの表示機能を使わずにVBAで横に表示する訳です。

strEmployees() = Split(DBSelect("質問者のSQL文"), ";")
N = UBound(strEmployees()) - 1
For I = 0 To N
　　Me.Cells(開始行, 開始列 + I) = strEmployees(I)
Next I

実質、僅か５行ですから、やっていることは理解できませんか？

＜アドバイス＞

このように僅か数行で目的を達成するには、作業を分割することです。
Accessからのデータの取得手続きは繰り返し発生するので、そこは関数に任せるのが一番。
CommandButton1_Click()では、関数から受け取ったデータを並べるだけに。
そうすると、何も考えないで２、３分でコードは書けます。

[イミディエイト]
? DBSelect("SELECT * FROM 担当者")
1;01: AAAA;True;True;2;02: BBBB;True;True;3;03: CCCC;False;True;

? DBSelect("SELECT * FROM 担当者",,vbcrlf)
1;01: AAAA;True;True;
2;02: BBBB;True;True;
3;03: CCCC;False;True;

では、一体、SQL文の実行結果をどのように受け取れば簡単に配列に取り込めるのかです。
それは、上述のように列と行とのデータを区切り子で区切った文字列として受け取ればいいです。

strEmployees() = Split(DBSelect("質問者のSQL文"), ";")

そうすりゃ、この１行で配列に取り込めます。

試しに、上の"質問者のSQL文"部分を正しく書いてコマンドボタンをクリックすりゃ表示されますよ。

＜準備＞

以下の関数を標準モジュールにコピペ。
もちろん、記号定数 pubCNNSTRING は、ちゃんと設定して下さい。

Public Const pubCNNSTRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\xxxx\xxxx.mdb"

Public Function DBSelect(ByVal strQuerySQL As String, _
　　　　　　　　　　　　 Optional cel_separator As String = ";", _
　　　　　　　　　　　　 Optional row_separator As String = "") As String
On Error GoTo Err_DBSelect
　　Dim I　　　　　 As Integer
　　Dim J　　　　　 As Integer
　　Dim R　　　　　 As Integer
　　Dim C　　　　　 As Integer
　　Dim M　　　　　 As Integer
　　Dim N　　　　　 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
　　　　　　N = .Fields.Count - 1
　　　　　　.MoveFirst
　　　　　　For R = 0 To M
　　　　　　　　C = -1
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　C = C + 1
　　　　　　　　　　strList = strList & fld.Value & "" & cel_separator
　　　　　　　　Next fld
　　　　　　　　strList = strList & row_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

お礼

できましたありがとうございます
mdbの数が多すぎが原因だったようです
ありがとうございます
感謝感激です

補足

お返事ありがとうございます
現在上記標準モジュール作成（.mdb）のパス記載し
フォーム内
下記を記述し（SQL文作成）しました
Const 開始行 = 1
Const 開始列 = 1

Private Sub CommandButton1_Click()
　　Dim I　　　　　　　As Integer
　　Dim N　　　　　　　As Integer
　　Dim strEmployees() As String

　　strEmployees() = Split(DBSelect("質問者のSQL文"), ";")
　　N = UBound(strEmployees()) - 1
　　For I = 0 To N
　　　　Me.Cells(開始行, 開始列 + I) = strEmployees(I)
　　Next I
End Sub
上記実行すると
コンパイルエラー
メソッドまたはデータメンバが見つかりません。
とでます。
どこがいけないのでしょうか？
よろしくお願い申し上げます