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

Private Sub メール送信_Click()

'日付が空白のコードを抽出し、メールアドレスを抽出する。

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Set cn = CurrentProject.Connection

Dim mySQL(1) As String

Dim strEmail As String

Dim str件名 As String

Dim str本文 As Variant

Dim str署名 As Variant

Dim str署名用改行 As String

'日付が空白のコードを抽出し、メールアドレスを抽出する。

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

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

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

  'メールアドレスを複数取得する。

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

  If IsNull(rs!メールアドレス) Then

  rs.MoveNext

  Else

  strEmail = strEmail & rs!メールアドレス & ";"

  rs.MoveNext

  End If

  Loop

str件名 = Me.件名 & Now

str本文 = Me.本文

str署名 = Me.署名

str署名用改行 = Me.署名用改行

'BCCのみでメール送信します

DoCmd.SendObject acSendNoObject, , , , , strEmail, str件名, str本文 & str署名用改行 & str署名, True

MsgBox "メール送信しました。", 64, "メール送信"

End Sub