SHOW:
|
|
- or go back to the newest paste.
| 1 | Public Sub SendEmailImpl(ByRef EmailAdressTo) | |
| 2 | - | Public Sub メール() |
| 2 | + | |
| 3 | Dim NotDB As Object ' lotus.NOTESDATABASE | |
| 4 | Dim NotDoc As Object ' lotus.NOTESDOCUMENT | |
| 5 | Dim NotItem As Object ' lotus.NOTESRICHTEXTITEM | |
| 6 | Dim NotAtt As Object ' lotus.NOTESEMBEDDEDOBJECT | |
| 7 | Dim AttFName As String ' 添付ファイル名(フルパス) | |
| 8 | ||
| 9 | ' Notesのセッションを起動する | |
| 10 | Set NotSet = CreateObject("Notes.NotesSession")
| |
| 11 | ' NotesDatabaseオブジェクトを作成し、そのデータベースを開く | |
| 12 | Set NotDB = NotSet.GETDATABASE("", "")
| |
| 13 | ' NotesDBをユーザーのメールDBに割り当てた後に開く | |
| 14 | NotDB.OpenMail | |
| 15 | ||
| 16 | ' NotesDBに文書を作成し、新規文書をオブジェクト変数にセットする | |
| 17 | Set NotDoc = NotDB.CREATEDOCUMENT() | |
| 18 | ' 件名をセットする | |
| 19 | NotDoc.Subject = "今日は当番です。" | |
| 20 | ' 宛先をセットする | |
| 21 | NotDoc.SendTo = Array(EmailAdressTo) | |
| 22 | - | NotDoc.SendTo = Array("[email protected]")
|
| 22 | + | 'NotDoc.CopyTo = Array(EmailAdressCC) |
| 23 | - | NotDoc.CopyTo = Array("[email protected]")
|
| 23 | + | |
| 24 | ||
| 25 | ' 文書にリッチテキストアイテムを作成する | |
| 26 | Set NotItem = NotDoc.CreateRichTextItem("BODY")
| |
| 27 | ' 本文をセットする | |
| 28 | With NotItem | |
| 29 | .APPENDTEXT "今日は当番日です。" | |
| 30 | .ADDNEWLINE 1 | |
| 31 | .APPENDTEXT "よろしくお願いいたします。" | |
| 32 | .ADDNEWLINE 2 | |
| 33 | ' 添付ファイル名をセットする | |
| 34 | ' AttFName = "D:\TEST\Book1.xls" | |
| 35 | ' ファイルを添付する | |
| 36 | ' Set NotAtt = .EmbedObject(EMBED_ATTACHMENT, "", AttFName) | |
| 37 | .ADDTAB 1 | |
| 38 | .ADDNEWLINE 1 | |
| 39 | End With | |
| 40 | ||
| 41 | ' メールを送信する | |
| 42 | NotDoc.Send False | |
| 43 | ||
| 44 | ' オブジェクト変数を解放する | |
| 45 | Set NotAtt = Nothing | |
| 46 | Set NotItem = Nothing | |
| 47 | Set NotDoc = Nothing | |
| 48 | Set NotDB = Nothing | |
| 49 | Set NotSet = Nothing | |
| 50 | ||
| 51 | MsgBox "メール発信", vbOKOnly + vbInformation | |
| 52 | ||
| 53 | End Sub | |
| 54 | Sub SendEmail | |
| 55 | ' @type {variant[5]}
| |
| 56 | Dim SendLists(4)' 5組あるとする | |
| 57 | - | Copy ToはCCです。 |
| 57 | + | '適当にでっち上げで作ったEmailAdress、適当に変えるべし。 |
| 58 | SendLists(0) = Array("[email protected]", "[email protected]")
| |
| 59 | - | よろしくお願いいたします。 |
| 59 | + | SendLists(1) = Array("[email protected]", "[email protected]")
|
| 60 | SendLists(2) = Array("[email protected]", "[email protected]")
| |
| 61 | SendLists(3) = Array("[email protected]", "[email protected]")
| |
| 62 | SendLists(4) = Array("[email protected]", "[email protected]")
| |
| 63 | ||
| 64 | Const BeginDate = DateValue("2017/01/02")'2017/01/02は月曜日、適当に変えるべし。
| |
| 65 | ||
| 66 | If Weekday(Date) = vbSunday And Weekday(Date) = vbSunday Then | |
| 67 | '土日だから死スべし、慈悲はない | |
| 68 | End If | |
| 69 | ||
| 70 | Const WeekDiff = DateDiff("w", Date, BeginDate)'これconstにできるのかね?わからん。
| |
| 71 | ||
| 72 | If WeekDiff < 0 Then | |
| 73 | 'BeginDateの設定がおかしい。起算日より前らしいで、今日は。 | |
| 74 | End If | |
| 75 | ||
| 76 | Dim Email | |
| 77 | '基準日(BeginDate)からの経過週をSendListsの要素数で割ったあまりに | |
| 78 | '今日の曜日(月曜日起算なので-2)を足してSendListsの要素数で割ったあまりを求めるのはだるいので | |
| 79 | '基準日(BeginDate)からの経過週に今日の曜日を足してSendListsの要素数で割ったあまりが送信対象の配列のoffset | |
| 80 | 'UBoundは配列の最大要素番号を返すんだってね、VBS作ったやつは頭がオカシイのでは? | |
| 81 | For Each Email In SendLists((WeekDiff + Weekday(Date) - 2) Mod (UBound(SendLists) + 1)) | |
| 82 | SendEmailImpl Email' CCに入れる条件が謎なので一件づつToにぶち込んでバラバラに送信 | |
| 83 | Next | |
| 84 | End Sub |