Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


240 / 13644 ツリー ←次へ | 前へ→

【81358】担当者を特定して、LOOPでメール作成。他のデータを抽出し表を作ってメール... カラメル 20/6/15(月) 3:03 質問[未読]

【81358】担当者を特定して、LOOPでメール作成。他...
質問  カラメル  - 20/6/15(月) 3:03 -

引用なし
パスワード
   アウトルックで、エクセルにあるデータを基にメールを送るマクロを作成しています。

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

240 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free