View difference between Paste ID: Pc6m00hj and 6PN6fDJb

 Public Sub SendEmailImpl(ByRef EmailAdressTo)
-Public Sub メール()
+
     Dim NotDB As Object     ' lotus.NOTESDATABASE
     Dim NotDoc As Object    ' lotus.NOTESDOCUMENT
     Dim NotItem As Object ' lotus.NOTESRICHTEXTITEM
     Dim NotAtt As Object    ' lotus.NOTESEMBEDDEDOBJECT
     Dim AttFName As String  ' 添付ファイル名(フルパス)
 
     ' Notesのセッションを起動する
     Set NotSet = CreateObject("Notes.NotesSession")
     ' NotesDatabaseオブジェクトを作成し、そのデータベースを開く
     Set NotDB = NotSet.GETDATABASE("", "")
     ' NotesDBをユーザーのメールDBに割り当てた後に開く
     NotDB.OpenMail
 
     ' NotesDBに文書を作成し、新規文書をオブジェクト変数にセットする
     Set NotDoc = NotDB.CREATEDOCUMENT()
     ' 件名をセットする
     NotDoc.Subject = "今日は当番です。"
     ' 宛先をセットする
     NotDoc.SendTo = Array(EmailAdressTo)
-    NotDoc.SendTo = Array("touban@notes.co.jp")
+    'NotDoc.CopyTo = Array(EmailAdressCC)
-    NotDoc.CopyTo = Array("touban2@notes.co.jp")
+
 
     ' 文書にリッチテキストアイテムを作成する
     Set NotItem = NotDoc.CreateRichTextItem("BODY")
     ' 本文をセットする
     With NotItem
         .APPENDTEXT "今日は当番日です。"
         .ADDNEWLINE 1
         .APPENDTEXT "よろしくお願いいたします。"
         .ADDNEWLINE 2
         ' 添付ファイル名をセットする
 '        AttFName = "D:\TEST\Book1.xls"
         ' ファイルを添付する
 '        Set NotAtt = .EmbedObject(EMBED_ATTACHMENT, "", AttFName)
         .ADDTAB 1
         .ADDNEWLINE 1
     End With
 
     ' メールを送信する
     NotDoc.Send False
 
     ' オブジェクト変数を解放する
     Set NotAtt = Nothing
     Set NotItem = Nothing
     Set NotDoc = Nothing
     Set NotDB = Nothing
     Set NotSet = Nothing
 
     MsgBox "メール発信", vbOKOnly + vbInformation
 
 End Sub
 Sub SendEmail
     ' @type {variant[5]}
     Dim SendLists(4)' 5組あるとする
-Copy ToはCCです。
+    '適当にでっち上げで作ったEmailAdress、適当に変えるべし。
     SendLists(0) = Array("connossixe-2899@yopmail.com", "Ressill1967@superrito.com")
-よろしくお願いいたします。
+    SendLists(1) = Array("creraposla@housat.com", "zuavuwrm@vomoto.com")
     SendLists(2) = Array("ivlayva2i4@g0b8oz.com", "_jof_19@d-yatzic-j.com")
     SendLists(3) = Array("kp3aw1csd365@1ce5b51f4.com", "lcpobyc@v8rl8bz.com")
     SendLists(4) = Array("d2m8qp.jq6_vxn2@8odkq2max.com", "v8mupqj3kzek0@td6dzh4v.com")
 
     Const BeginDate = DateValue("2017/01/02")'2017/01/02は月曜日、適当に変えるべし。
 
     If Weekday(Date) = vbSunday And Weekday(Date) = vbSunday Then
         '土日だから死スべし、慈悲はない
     End If
 
     Const WeekDiff = DateDiff("w", Date, BeginDate)'これconstにできるのかね？わからん。
 
     If WeekDiff < 0 Then
         'BeginDateの設定がおかしい。起算日より前らしいで、今日は。
     End If
 
     Dim Email
     '基準日(BeginDate)からの経過週をSendListsの要素数で割ったあまりに
     '今日の曜日(月曜日起算なので-2)を足してSendListsの要素数で割ったあまりを求めるのはだるいので
     '基準日(BeginDate)からの経過週に今日の曜日を足してSendListsの要素数で割ったあまりが送信対象の配列のoffset
     'UBoundは配列の最大要素番号を返すんだってね、VBS作ったやつは頭がオカシイのでは？
     For Each Email In SendLists((WeekDiff + Weekday(Date) - 2) Mod (UBound(SendLists) + 1))
         SendEmailImpl Email' CCに入れる条件が謎なので一件づつToにぶち込んでバラバラに送信
     Next
 End Sub