複数条件ADO接続

質問

お世話になります
■概要
ExcelからAccessに接続し値を取り出し貼り付ける

■詳細
ExcelマクロフォームにTextbox1、Textbox2、実行ボタン

■動作
Textbox1に、発注日ここからの日付 Textbox2に発注日ここまで日付
を入力実行ボタンを押すとExcelファイル内セルB10より貼り付け

■AccessDB
ID|お客様名|発注日|記事|取消CK

■その他
1、DB内には不要な列もある
2、取消CKはYes,No型で、チェックがあるレコードだけは抜き出さない
でExcel側ではその行は空白ではなく詰めて落とし込みをしたい

難しいですが分かる方宜しくお願いします。
当方初心者ですコードでお願いします

回答No.7

mitarashi · ベストアンサー

>1,間に挟まれた日付けも貼り付けしたいですが
発注日と発送日の間に挟まれる日付のデータを貼り付けるというのは意味が分かりかねます。
発注日が何月何日から、何月何日の間、
発送日が何月何日から、何月何日の間というご主旨なら分かりますが。
いずれにしても、ご希望の事をAccessのクエリで実現できれば、それをExcel側で実現する術は会得されたのではないかと思いますが如何でしょうか。

回答No.6

mitarashi

一度に全部やろうとすると、どこでトラぶっているかわかりにくいので、順を追って進める事をおすすめします。
１．標準モジュールで、アクセスと同じSQL動作を実現させる。
２．各日付の所を変数で与える様にしてみる。
３．UserFormに載せ替えて、変数の部分をテキストボックスから与える様にする。
UserFormに載せ替えた例は下記の通りです。当方環境では動作しました。
既にお分かりと思いますが、mySQLは文字列変数と組み合わせて、全体が一つの文字列になる必要があります。当方のコードの _ による改行と、OKWave画面で表示される改行は一致していませんので、ご注意下さい。
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(TextBox1.Value), "mm/dd/yyyy")
shipDate = Format(DateValue(TextBox2.Value), "mm/dd/yyyy")

myDBFName = "C:\test.mdb" 'mdbのフルパス
myPswd = ""
myConstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& myDBFName & ";Jet OLEDB:Database Password=" & myPswd & ";"

mySQL = "SELECT 管理.お客様名, 管理.発注日, 管理.発送日, 管理.記事, 管理.取消CK FROM 管理 " & _
"WHERE (((管理.発注日)=#" & orderDate & "#) AND ((管理.発送日)=#" & shipDate & _
"#) AND ((管理.取消CK)=No));"

Set myConn = New ADODB.Connection
myConn.Open myConstr
Set myRs = New ADODB.Recordset
myRs.Open mySQL, myConn
Worksheets("Sheet1").Range("B10").CopyFromRecordset myRs
myRs.Close
Set myRs = Nothing
myConn.Close
Set myConn = Nothing
Unload Me
End Sub

お礼

お返事ありがとうございます
上記の質問
2,Microsoft Date and Time Picker Control 6.0 (SP4)を適用させたい件ですができました。
下記のようにすれば使用可能になりました
orderDate = Format(DateValue(DTPicker1.Value), "mm/dd/yyyy")
shipDate = Format(DateValue(DTPicker2.Value), "mm/dd/yyyy")

補足

■お返事まことにありがとうございます
mitarashi様のおかげさまで動作確認取れました。
■原因は私の勘違いでAccess側にMicrosoft ActiveX Data Objects 2.8 Libray を選択してたことにありますExcel側でした。

私の言葉足らずのせいか動作は、一致したものに対してExcelに張り付くものですが、
■できれば
1,間に挟まれた日付けも貼り付けしたですが
2,Microsoft Date and Time Picker Control 6.0 (SP4)を適用させたい。

本当にすみませんこれが最後の難題です、ご迷惑をお掛けしますm(__)m

回答No.5

mitarashi

>ユーザ定義型は定義されていません
Dim myConn As ADODB.Connectioのところで発生するのでしょうか？
だとすると、ADOに参照設定してないのではないでしょうか。
Microsoft ActiveX Data Objects 2.x Libray
に参照設定してください。xが1～8位まで沢山候補があがりますが、新しい（番号の大きいもの）を選択してください。一つだけで良いです。
参照設定の方法はリンク先でご覧下さい。

参考URL：

http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_040_04.html

お礼

お返事ありがとうございます

補足

お返事まことにありがとうございます
言葉がたらす申し訳ありません
エラー箇所はmyConn As ADODB.Connectionのところで発生しています。
ADOに参照設定されていない件ですが
間違いなく
Microsoft ActiveX Data Objects 2.8 Libray
を登録しました。

今から色々試してみます

回答No.4

mitarashi

#1～3です
大サービスしちゃいます。（自分でも興味があったので、やってみただけですが）
startDate = Format(DateValue(TextBox1.Value), "mm/dd/yyyy")
endDate = Format(DateValue(TextBox2.Value), "mm/dd/yyyy")
（注）
#3～4の話は、日付が日付型で入っていることを前提としております。念のため。

お礼

お返事ありがとうございます
もう少しの間、宜しくお願いします
当方どうしても完成させたく宜しくお願い申し上げますm(__)m

補足

お返事大変ありがとうございます
SQL分をあわせると下記の内容でよろしかったでしょうか？
mySQL = "SELECT 管理.お客様名, 管理.発注日, 管理.発送日, 管理.記事, 管理.取消CK FROM 管理 " & _
"WHERE (((管理.発注日)=#" & "startDate = Format(DateValue(TextBox1.Value), "mm/dd/yyyy")" & "#) AND ((管理.発送日)=#" & "endDate = Format(DateValue(TextBox2.Value), "mm/dd/yyyy")
" & _
"#) AND ((管理.取消CK)=No));"

回答No.3

mitarashi

mySQL = "????" のWクォーテーションの間に、AccessのSQL文を入れ、次いで今回の事例では日付の部分を定数→変数に変更する必要があります。
SQL文は自分の印象では結構気むずかしく、スペース一個違っても動きませんので、動作を確認しながら少しずつ改造して行くのが吉です。
日付は下掲の様に12/25/2007（今年のX'mas）の形で与えないとダメみたいです。シングルクォーテーションや、%の話は、LIKEを使わなければ気にしなくて結構です。*子→花子を、ADOでは%子にする必要があるという話です。
Sub readAllData()
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

myDBFName = "C:\test.mdb" 'mdbのフルパス
myPswd = ""
myConstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& myDBFName & ";Jet OLEDB:Database Password=" & myPswd & ";"

'mySQL = "SELECT 管理.お客様名, 管理.発注日, 管理.発送日, 管理.記事, 管理.取消CK FROM 管理 " & _
"WHERE (((管理.発注日)=#12/13/2007#) AND ((管理.発送日)=#12/16/2007#) AND ((管理.取消CK)=No));"

'日付の形に注意　"12/13/2007"　や、"12/16/2007"　を変数にしてテキストボックスから取得
mySQL = "SELECT 管理.お客様名, 管理.発注日, 管理.発送日, 管理.記事, 管理.取消CK FROM 管理 " & _
"WHERE (((管理.発注日)=#" & "12/13/2007" & "#) AND ((管理.発送日)=#" & "12/16/2007" & _
"#) AND ((管理.取消CK)=No));"

Set myConn = New ADODB.Connection
myConn.Open myConstr
Set myRs = New ADODB.Recordset
myRs.Open mySQL, myConn
Worksheets("Sheet1").Range("B10").CopyFromRecordset myRs
myRs.Close
Set myRs = Nothing
myConn.Close
Set myConn = Nothing
End Sub

お礼

お返事ありがとうございます

補足

お返事ありがとうございます
■Sub readAllData()←は不要ですよかったでしょうか？
上記の代わりに下記を挿入しました。
Private Sub CommandButton1_Click()
■Dim tableName As String←削除しました

■上記２点を編集し実行させたら以下のような
エラーが発生しました
コンパイルエラー、ユーザ定義型は定義されていません
Access側も日付/時刻型は確認済みです

何度も申し訳ないです宜しくお願い申し上げます。m(__)m

回答No.2

mitarashi

#1です。
Dim tableName As String　は消し忘れなので不要です。

お礼

お返事ありがとうございます

回答No.1

mitarashi

やりたい事をまずAccessのクエリで実現してみてください。TextBox1,2から与える内容は、適当な値（当然テーブルに含まれる）を設定してください。
クエリを編集モードにした後、大抵はツールバーの左隅にあるビューのメニューから、SQLビューに切り替えて表示されたSQL文をコピーしてください。
下記コードのmdbのパスを貴方の環境に合わせ、SQL文には先にコピーしたものを貼り付けてください。
但し、コード中に記してある事に配慮する必要があります。
以上、お試し下さい。
'Microsoft ActiveX Data Objects 2.x Libray に参照設定
'Access2003以前の場合
Sub readAllData()
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

myDBFName = "C:\Documents and Settings\?????\My Documents\?????.mdb" 'mdbのフルパス
myPswd = ""
myConstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& myDBFName & ";Jet OLEDB:Database Password=" & myPswd & ";"

mySQL = "?????;" 'AccessのクエリをSQL表示させたものをコピーし改造
'クエリで用いた抽出条件をTextBoxの値に置き換える
'AccessのSQL中の " を、' に置き換える
'ワイルドカードの* を%　に置き換える
Set myConn = New ADODB.Connection
myConn.Open myConstr
Set myRs = New ADODB.Recordset
myRs.Open mySQL, myConn
Worksheets("Sheet1").Range("B10").CopyFromRecordset myRs
myRs.Close
Set myRs = Nothing
myConn.Close
Set myConn = Nothing
End Sub

お礼

お返事ありがとうございます

補足

お返事ありがとうございます
がんばったのですが分からないところが多数出たのでもう少しご教授
頂ければ幸いです。
■実行したこと
Excel側にVBA UserForm1を設置
UserForm1内にTextBox1,TextBox2,CommandButton1を設置しました。
UserForm1内VBAは下記のように設定しました。
Private Sub CommandButton1_Click()
myDBFName = "C:\TEST.mdb" 'mdbのフルパス
myPswd = ""
myConstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& myDBFName & ";Jet OLEDB:Database Password=" & myPswd & ";"

mySQL = "SELECT 管理.お客様名, 管理.発注日, 管理.配送日, 管理.記事, 管理.取消CK"
FROM 管理
WHERE (((管理.発注日)>=#TextBox1#) AND ((管理.配送日)<=#TextBox2#) AND ((管理.取消CK)=No));

'AccessのクエリをSQL表示させたものをコピーし改造
'クエリで用いた抽出条件をTextBoxの値に置き換える
'AccessのSQL中の " を、' に置き換える
'ワイルドカードの* を%　に置き換える
Set myConn = New ADODB.Connection
myConn.Open myConstr
Set myRs = New ADODB.Recordset
myRs.Open mySQL, myConn
Worksheets("Sheet1").Range("B10").CopyFromRecordset myRs
myRs.Close
Set myRs = Nothing
myConn.Close
Set myConn = Nothing
End Sub
■分からないこと
1このまま実行するとコンパイルエラーが出ます
Sub　またはFunctionが定義されていません

SQLの"がありません
ワイルドカードってなんですか？
初心者すぎる質問で申し訳ありません
宜しくお願いします