| |
▼Gin_II さん：たぬき さん
>>配信先用にT_Mailと言うテーブルに送りたい人達のアドレスを記入しているのですが、
>>一番最後のレコードの人にしか配信できません。
>>どのようにしたらテーブル全員へ配信出来ますでしょうか？
>
>プログラムのロジックが間違っているのでしょうけど、そのプログラムを
>提示されないと、どこが間違っているのか指摘はできないと思いますが ^^;
>>>Gin_IIさん、たぬきさん、せっかくの返答に答えが遅くてすみません。ありがとうございます。
>>>お粗末ながら、
Public Sub MailSubmit2()
Dim dbDAO As DAO.Database
Dim rsDAO, rsMDAO, rsM2DAO As DAO.Recordset
Dim strEmail, strEmail2 As Variant '-----送信先とCCのEmailアドレスです。
Dim strSubject As String '-----件名です。
Dim strText As String '-----署名を含む本文です。
Dim strDate As String '-----対象期間として差し込む日付文字列です。
Dim strSQLM, strSQLM2 As String
Dim i As Integer
strSQLM = _
"SELECT * FROM T_Mail where flg = 1"
Set dbDAO = CurrentDb
Set rsDAO = dbDAO.OpenRecordset("Q_対象期間2", dbOpenDynaset)
Set rsMDAO = dbDAO.OpenRecordset(strSQLM)
DoCmd.SetWarnings False
rsMDAO.MoveFirst
Do Until rsMDAO.EOF = True
'strEmail = rsMDAO(0) & ";"
strEmail = rsMDAO!Mail & ";"
rsMDAO.MoveNext
Loop
If Right(strEmail, 1) = ";" Then
strEmail = Left(strEmail, Len(strEmail) - 1)
End If
Next
'------------------------------------------------------以下CC用
strSQLM2 = _
"SELECT * FROM T_Mail_CC where flg = 1"
Set db = CurrentDb
Set rs = db.OpenRecordset("Q_対象期間2")
Set rsM2 = db.OpenRecordset(strSQLM2)
DoCmd.SetWarnings False
rsM2DAO.MoveFirst
Do Until rsM2.EOF
strEmail2 = rsM2(0) & ";"
strEmail2 = rsM2DAO!Mail
rsM2DAO.MoveNext
Loop
If Right(strEmail2, 1) = ";" Then
strEmail2 = Left(strEmail2, Len(strEmail2) - 1)
End If
'-----件名は動的に差込み
strSubject = "テスト & DateDiff("ww", #1/1/2003#, Date) - 21 & "-Web資料請求（デイリー）投入しました"
rs.MoveFirst
strDate = rs!対象期間 & "〜"
rs.MoveLast
'-----以下の式が成り立てば対象日付は複数あるので、･･･
If Left(strDate, Len(strDate) - 1) <> rs!対象期間 Then
strDate = strDate & rs!対象期間
Else
'-----対象日付が１日のみであれば、「〜」の文字列を省く
strDate = Left(strDate, Len(strDate) - 1)
End If
'-----以下、メール文言ココカラ（署名含む）
strText = vbCrLf & " 各位" & vbCrLf & vbCrLf & _
" 『" & DateDiff("ww", #1/1/2003#, Date) - 21 & "-資料請求（デイリー）』の投入が完了致しました。" & vbCrLf & _
" コール可能な状態になっております。" & vbCrLf & vbCrLf & _
" 対象期間：" & strDate & vbCrLf & vbCrLf & _
" 件数：" & DLookup("Count", "Q_Count") & " 件" & vbCrLf & vbCrLf & _
" ご確認ください。" & vbCrLf & vbCrLf & vbCrLf & _
" 株式会社 ○○" & vbCrLf & vbCrLf & _
" △△事業本部 ××営業部" & vbCrLf & _
" furau" & vbCrLf & _
" e-mail : x-xxxx2@xx.com" & vbCrLf & _
" TEL：xx-xxxx-xxxx/FAX：xx-xxxx-xxxx"
'-----メール文言ココマデ
DoCmd.SendObject acSendNoObject, , acFormatHTML, strEmail, strEmail2, , strSubject, strText, True
DoCmd.SetWarnings True
rsMDAO.Close: Set rsM = Nothing
rsDAO.Close: Set rs = Nothing
dbDAO.Close: Set db = Nothing
End Sub
|
|
furau
- 06/3/27(月) 12:18 -
