VBAの構文

質問

Access2002を使用しています。
VBAにて、クエリの結果をメール本文に書き出したいのですが
宜しくお願いします。

【使用するクエリ】
クエリ名：果物クエリ（選択クエリ）
フィールド項目：日付、注文者、発送先、電話番号、品名、数量

【現在の内容】

Private Sub コマンド1_Click()
On Error GoTo Err_コマンド1_Click

Dim stDocName As String
Dim strsubject As String
Dim strmailto As String
Dim strmailto2 As String
Dim strtext0 As String
Dim strText1 As String
Dim strText2 As String
Dim strText3 As String
Dim strText4 As String
Dim strText5 As String
Dim strtext6 As String
Dim strtext7 As String
Dim strtext8 As String
Dim strtext9 As String
strmailto = Me.電子メール_アドレス
strsubject = "商品発送のお知らせ"
strText1 = Me.氏名 & " 様"

strText2 = "いつもお世話になります、第一青果です。"

strText3 = "以下の商品を発送致しましたのでご確認下さいませ。 "

strtext0 = "---------------------------------"

strText4 = "何でも新鮮！"

strText5 = "第一青果"

strtext6 = "担当：山田　太郎"

strtext7 = "mailto:info@808yaoya.net"

strtext8 = "http://808yaoya.net"

strtext9 =　★ここからクエリ内の「品名」と「数量」を書き出したい！★

★以下、現在はレポートをエクセルファイルにして添付するようにしている★
stDocName = ChrW(32013) & ChrW(21697) & ChrW(12524) & ChrW(12509) & ChrW(12540) & ChrW(12488)
DoCmd.SendObject acReport, stDocName, , strmailto, , , strsubject, strText1 & vbCrLf & vbCrLf & strText2 & _
vbCrLf & strText3 & vbCrLf & vbCrLf & strtext0 & vbCrLf & strText4 & vbCrLf & strText5 & vbCrLf & strtext6 & vbCrLf & _
strtext7 & vbCrLf & strtext8 & vbCrLf & strtext0　& vbCrLf & strtext9, True

Exit_コマンド1_Click:
Exit Sub

Err_コマンド1_Click:
MsgBox Err.Description
Resume Exit_コマンド1_Click

End Sub

回答No.3

piroin654 · ベストアンサー

方法は二つあります。一つは登録されている
果物クエリを使用する方法、もう一つは
果物クエリをSQL文にし、手直しをして
VBA内で使用する方法です。この場合は
SQL文の修正だけですみますが、クエリを
使う場合はパラメータの処理をVBA内で
する必要があります。

必要な設定を一応しておきます。

果物クエリの設定
果物クエリの顧客IDの抽出条件に
[Forms]![F検索]![tx顧客ID]
を設定
果物クエリの日付の抽出条件に
Between [Forms]![F検索]![tx検索開始日] And [Forms]![F検索]![tx検索終了日]
を設定

フォームの設定
前回同様、フォームをF検索とします。
フォームには４つのテキストボックスを
おきます。
tx検索開始日、 tx検索終了日
tx顧客ID、tx氏名(これは氏名のことです）
氏名をtx氏名に、また
電子メール_アドレスをtx電子メール_アドレス
に変えていますが、必要なら変更してください。

コードの設定
変数は最初から設定しなおします。

'ここから

Option Compare Database
Option Explicit

'テキストボックスtx顧客IDの更新後処理
Private Sub tx顧客ID_AfterUpdate()
Dim db As Database
Dim rs As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("T受注", dbOpenDynaset)

rs.FindFirst "顧客ID = " & Me!tx顧客ID & ""
If rs.NoMatch Then
MsgBox ("該当者はいません。")
Me!tx顧客ID = ""
Else
Me.tx氏名 = rs!注文者
End If
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub

Private Sub コマンド1_Click()
Dim stDocName As String
Dim strsubject As String
Dim strmailto As String
Dim strmailto2 As String
Dim strtext0 As String
Dim strText1 As String
Dim strText2 As String
Dim strText3 As String
Dim strText4 As String
Dim strText5 As String
Dim strtext6 As String
Dim strtext7 As String
Dim strtext8 As String
Dim strtext9 As String

Dim myText As String
Dim qdf As QueryDef
Dim db As Database
Dim rs As Recordset

'入力チェック。未入力の場合はボタンクリックをキャンセル
If IsNull(Me.tx顧客ID) Then
MsgBox ("顧客IDが未入力です。")
Exit Sub
End If

If IsNull(Me.tx検索開始日) Then
MsgBox ("検索開始日が未入力です。")
Exit Sub
End If

If IsNull(Me.tx検索終了日) Then
MsgBox ("検索終了日が未入力です。")
Exit Sub
End If

'myTextの初期化
myText = ""

Set db = CurrentDb
Set qdf = db.QueryDefs("果物クエリ1")
'パラメータの設定　クエリを直接使う場合はこれが必要
qdf.Parameters(0) = [Forms]![F検索1]![tx顧客ID]
qdf.Parameters(1) = [Forms]![F検索1]![tx検索開始日]
qdf.Parameters(2) = [Forms]![F検索1]![tx検索終了日]
Set rs = qdf.OpenRecordset

strmailto = Me.tx電子メール_アドレス
strsubject = "商品発送のお知らせ"
strText1 = Me.tx氏名 & " 様"

strText2 = "いつもお世話になります、第一青果です。"

strText3 = "以下の商品を発送致しましたのでご確認下さいませ。 "

strtext0 = "---------------------------------"

strText4 = "何でも新鮮！"

strText5 = "第一青果"

strtext6 = "担当：山田　太郎"

strtext7 = "mailto:info@808yaoya.net"

strtext8 = "?http://808yaoya.net?"

If rs.RecordCount > 0 Then
rs.FindFirst "[注文者] = '" & Me!氏名 & "'"
If rs.NoMatch Then
MsgBox ("該当者はいません。")
Else
rs.MoveFirst
Do Until rs.EOF
'strtextに情報を押し込み中
myText = myText & rs!品名 & " " & rs!数量 & vbCrLf
rs.MoveNext
Loop
End If
Else
MsgBox ("注文はありません。")
End If

'ループを抜けた後myTest取り出すと一括して変数に格納された状態で取り出せる
'メッセージボックスで表示してみる 必要なければメッセージボックス表示を削除
strtext9 = myText
MsgBox strtext9

rs.Close
Set rs = Nothing
Set qdf = Nothing
db.Close
Set db = Nothing
End Sub

回答No.6

piroin654

いい感じですね。
それではテーブル及び果物クエリに品物の
単価として金額フィールドが追加された
ということでこれを元にして合計を出す、
ということですね。
では、DSumとかではなく、VBAの中で
計算します。そのほうが簡単で判りやすい、
と思われます。金額はテーブルで通貨型
であるとします。コード中に金額と合計
を計算します。

(1) 果物クエリを使う場合。

変数の追加。

Dim kei As Currency
Dim strtext10 As String

コードの追加変更。

If rs.RecordCount > 0 Then
rs.FindFirst "[注文者] = '" & Me!tx氏名 & "'"
If rs.NoMatch Then
MsgBox ("該当者はいません。")
Else
rs.MoveFirst
Do Until rs.EOF
'strtextに情報を押し込み中

'追加部分あり
myText = myText & rs!品名 & " " & rs!数量 & " " & rs!金額 & vbCrLf
kei = kei + rs!数量 * rs!金額

rs.MoveNext
Loop
End If
Else
MsgBox ("注文はありません。")
End If

'ループを抜けた後myTest取り出すと一括して変数に格納された状態で取り出せる
'メッセージボックスで表示してみる 必要なければメッセージボックス表示を削除
strtext9 = myText
'追加部分
strtext10 = "合計= \" & kei
MsgBox strtext9 & vbCrLf & strtext10

(2) SQL文を使う場合
SQL文に

SELECT T受注.顧客ID, T受注.日付, T受注.注文者, T受注.発送先, T受注.電話番号, T受注.品名, T受注.数量, T受注.金額 " & _

のように金額フィールドを追加してください。
あとは果物クエリを使う場合と同じです。

金額と合計はこれで取れると思いますが、
何かあれば書き込んでください。

お礼

piroin654　様

この度はいろいろとご指導戴きまして、本当に有難う御座いました。
ご教授いただきました内容で全て思ったとおりのプログラムを
作成する事が出来、本当に嬉しい限りです。
本来ならば別途お礼をして差し上げたいところで御座いますが、
サイトの趣旨に反するとの事でありますので、本文面にて
変えさせて戴きたいと思います。
有難う御座いました。

因みに、全体的にはSQL文ではない方を選択して、解決しました。
それと、抽出日付の部分はご教授いただきました通り、非連結のテキストボックスを使用し、IDは変数格納のInputBoｘにて入力するようにしました。（これは毎回違うIDを使用するので便宜上です。）

お陰様でコマンドボタン、ID入力、メール送信の僅か3回の作業で
簡単に結果を送信する事が可能となりました。

未熟者では御座いますが、今後ともご指導宜しくお願い致します。

回答No.5

piroin654

操作は、
tx顧客IDに注文者のIDを入力した後、
何かをするとtx氏名に注文者名が
表示されます。tx顧客IDの更新後
処理なので遅れて表示されます。

最初のコードの中で果物クエリが
果物クエリ1になっていました。
訂正をしておいてください。

何かあれば書き込みをしてください。

お礼

piroin654　様

ほぼ完璧に出来ました。有難う御座いました。

処理の順序からして、注文が無かった場合はその時点でメール送信文を作成する必要が無いので、以下文を先に入れました。
--------------------------------------------
If rs.RecordCount = 0 Then
MsgBox ("売り上げレコードはありません。")

Exit Sub
End If
--------------------------------------------
それと、金額も入るようにしたのですが、「rs!金額」とした時に
金額の合計を計算したいのですが、Sum,DSumを使った式で
うまく出来ませんでした。
お時間がある時にまたご教授頂ければ助かります。

回答No.4

piroin654

二番目の方法です。
クエリの参照テーブルはこちらで適当に
T受注としてフィールドを適当に設定
しています。

'####kここから####
Option Compare Database
Option Explicit

Private Sub tx顧客ID_AfterUpdate()
Dim db As Database
Dim rs As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("T受注", dbOpenDynaset)

rs.FindFirst "顧客ID = " & Me!tx顧客ID & ""
If rs.NoMatch Then
MsgBox ("該当者はいません。")
Me!tx顧客ID = ""
Else
Me.tx氏名 = rs!注文者
End If
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub

Private Sub コマンド1_Click()
Dim stDocName As String
Dim strsubject As String
Dim strmailto As String
Dim strmailto2 As String
Dim strtext0 As String
Dim strText1 As String
Dim strText2 As String
Dim strText3 As String
Dim strText4 As String
Dim strText5 As String
Dim strtext6 As String
Dim strtext7 As String
Dim strtext8 As String
Dim strtext9 As String
Dim myText As String

Dim strSQL As String

Dim db As Database
Dim rs As Recordset

strSQL = "SELECT T受注.顧客ID, T受注.日付, T受注.注文者, T受注.発送先, T受注.電話番号, T受注.品名, T受注.数

量 " & _
"FROM T受注 " & _
"WHERE (((T受注.顧客ID)= " & [Forms]![F検索]![tx顧客ID] & ") AND ((T受注.日付) Between #" &

[Forms]![F検索]![tx検索開始日] & "# And #" & [Forms]![F検索]![tx検索終了日] & "#));"

'入力チェック。未入力の場合はボタンクリックをキャンセル
If IsNull(Me.tx顧客ID) Then
MsgBox ("顧客IDが未入力です。")
Exit Sub
End If

If IsNull(Me.tx検索開始日) Then
MsgBox ("検索開始日が未入力です。")
Exit Sub
End If

If IsNull(Me.tx検索終了日) Then
MsgBox ("検索終了日が未入力です。")
Exit Sub
End If

myText = ""

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)

'strtmailtoからstrtext8

If rs.RecordCount > 0 Then
rs.FindFirst "[注文者] = '" & Me!tx氏名 & "'"
If rs.NoMatch Then
MsgBox ("該当者はいません。")
Else
rs.MoveFirst
Do Until rs.EOF
'myTextに情報を押し込み中
myText = myText & rs!品名 & " " & rs!数量 & vbCrLf
rs.MoveNext
Loop
End If
Else
MsgBox ("注文はありません。")
End If

'ループを抜けた後myTest取り出すと一括して変数に格納された状態で取り出せる
'メッセージボックスで表示してみる
strtext9 = myText
MsgBox strtext9

rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub

お礼

piroin654さん、いつもご指導有難う御座います。
早速、試してみます。
結果はまた報告させていただきます。

回答No.2

piroin654

コードを送りましたが、少し
気になることがあったので確認
です。
送りましたコードは一件しか
情報を取り出していません。
もし果物クエリが一人の
注文者の複数の品物の注文も
含んでいる場合は、コードを若干
変更する必要があります。
そのあたりはどうでしょうか。
果物クエリがどのような情報を
抽出しているのかわからない、
ということと、複数の品物も
あるのか、というあたりを
教えていただければいいのですが。

補足

piroin654さん、度々気にかけて頂きまして有難う御座います。

現在、あと少しのところまで出来ているので、宜しくお願いします。

問題点　（説明不足ですいません。）

ご指摘の通り、クエリの抽出を良く説明していませんでしたので、余計なエラーが出ます。（パラメータを使用しています）

選択クエリのパラメータは
１．誰が注文した物か？　（顧客IDを指定する）
２．その注文を抽出する期間は？（between #0000/00/00# and #0000/00/00#）

それによって求める結果は
１．商品名（多種あり）
２．数量

※パラメータをはずすと、ご心配頂きました通り、該当する1行目だけが抽出されますので多種対応が可能な構文を必要としています。
それと、VBAでパラメータを指定してやる構文をご教授頂ければ助かります。

恐れ入りますが、宜しくお願い致します。

回答No.1

piroin654

モジュールに以下を追加してください。
なお、DAOで対応しているので参照設定
でDAOにチェックを入れてください。

'変数の追加
'ここではIntegerですがテーブルが
'文字列ならばStringに変更してください。
Dim strtext10 As Integer
Dim db As Database
Dim rs As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("果物クエリ", dbOpenSnapshot)

'クエリより情報抽出。strtext8の後に

With rs
rs.FindFirst "[注文者] = '" & Me!氏名 & " ' "
If rs.NoMatch Then
MsgBox ("該当者はいません。")
Else
strtext9 = rs!注文者
strtext10 = rs!数量
MsgBox strtext9 & " " & strtext10
End If
End With

'End Subの直前に配置
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing

質問を読み間違えていなければ
こういうことだろうと思いますが。

お礼

piroin654さん、ご指導有難う御座いました。
早速、試してみます。