| |
アウトルックで、エクセルにあるデータを基にメールを送るマクロを作成しています。
nameで定義されている課題の担当者ごとに課題をまとめて、担当者ごとにメールを送りたいです。
どのようなコードを書けばよろしいですか。
とても、わかりにくいかと思いますが、ぜひお助けください。
よろしくお願いいたします。
担当者ごとにLOOPでプログラムを実行したいです。
Dim objOutlook As Outlook.Application
Set objOutlook = New Outlook.Application
Dim objMail As Outlook.MailItem
Set objMail = objOutlook.CreateItem(olMailItem)
'--- Excelワークシート ---'
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("担当者")
'--- メールの内容を格納する変数 ---'
Dim toStr As String
Dim ccStr As String
Dim bccStr As String
Dim subjectStr As String
Dim bodyStr As String
Dim id As Long
Dim name As String
Dim i As Integer
Dim ID As Integer
Dim nittei As Date
Dim IDStr As String
Dim nitteiStr As String
'For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'ID = Cells(i, 4)
'nittei = Cells(i, 29)
'IDStr = Str(keyID)
'nitteiStr = Str(kigenbi)
'id = Cells(i, 22)
'name = Cells(i, 23)
'--- 件名の内容 ---'
subjectStr = "課題について"
'--- 宛先の内容 ---'
'If ws2.Cells(2, 1) = tanto_id Then
'ws2.Cells(2, 2) = tanto_name
'ws2.Cells(2, 3).Value = toStr
'End If
'--- 本文の内容 ---'
'For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
bodyStr = tanto_name & "様" & "<br>" & "<br>" & "課題処理お願いいたします。"
bodyStr = bodyStr + "<html><body><table border=1>"
bodyStr = bodyStr + "<tr bgcolor =#191970><th>ID</th><th>課題名</th><th>種類</th><th>状態</th><th>日程</th></tr>"
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'Set objMail = objOutlook.CreateItem(olMailItem)
If (Cells(i, 22) = tanto_id) Then
keyID = Cells(i, 4)
kigenbi = Cells(i, 29)
keyStr = Str(keyID)
kigenStr = Str(kigenbi)
bodyStr = bodyStr + "<tr style=color:red><td>"
bodyStr = bodyStr + idStr
bodyStr = bodyStr + "</td><td>"
bodyStr = bodyStr + Cells(i, 7)
bodyStr = bodyStr + "</td><td>"
bodyStr = bodyStr + Cells(i, 12)
bodyStr = bodyStr + "</td><td>"
bodyStr = bodyStr + Cells(i, 15)
bodyStr = bodyStr + "</td><td>"
bodyStr = bodyStr + nitteiStr
bodyStr = bodyStr + "</td></tr>"
End If
Next i
bodyStr = bodyStr + "</table></body></html>"
'--- 条件を設定 ---'
objMail.To = toStr
objMail.CC = ccStr
objMail.BCC = bccStr
objMail.Subject = subjectStr
objMail.HTMLBody = bodyStr
'--- メールを表示 ---'
objMail.Display
End Sub
|
|
カラメル
- 20/6/15(月) 3:03 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
≪
