'-------------------------

Private Sub メール送信履歴登録()

'メール送信履歴登録をします。

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Set cn = CurrentProject.Connection

Dim mySQL(2) As String

Dim strmsg As String

Dim str As Variant

'メルアドを抽出したい

mySQL(0) = "SELECT DISTINCT コード FROM テーブル1 WHERE isnull(日付);"

mySQL(1) = "SELECT メールアドレス FROM テーブル2 WHERE コード= any (" & mySQL(0) & ")"

rs.Open mySQL(1), cn, adOpenForwardOnly, adLockOptimistic

str = Null

'コードを複数取得する。

  Do Until rs.EOF '対象とするテーブルの最後まで進みます。

  str = str & IIf(Not IsNull(str), ",", "") & "'" & rs!コード & "'"

  rs.MoveNext

  Loop

'テーブル4からWhere〜In〜で抽出した情報を、テーブル3に追加クエリで追加する

mySQL = "INSERT INTO テーブル3 ( 顧客名,顧客担当者,メールアドレス)" & _

  "Select コード, 顧客名, 顧客担当者,メールアドレス, #" & Now() & "# " & _

  "From テーブル4 Where テーブル2.コード In(" & str & ");"

DoCmd.SetWarnings False

DoCmd.RunSQL mySQL2

DoCmd.SetWarnings True

MsgBox "メール送信履歴登録しました。", 64, "メール送信履歴登録"

Set rs = Nothing

Set cn = Nothing

End Sub