| 
    
     |  | アウトルックで、エクセルにあるデータを基にメールを送るマクロを作成しています。 
 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
 
 |  |