範囲（行）の各人にメッセージをメール

Question

Ron de Bruinsのコードを列から行に変更する方法について質問したいと思います（たとえば、行1に名前が含まれ、行2に電子メールが、行3にはい、もしくは、いいえ）。

Sub Test1() 
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm 
'Working in Office 2000-2016 
Dim OutApp As Object 
Dim OutMail As Object 
Dim cell As Range 

Application.ScreenUpdating = False 
Set OutApp = CreateObject("Outlook.Application") 

On Error GoTo cleanup 
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants) 
    If cell.Value Like "?*@?*.?*" And _ 
     LCase(Cells(cell.Row, "C").Value) = "yes" Then 

     Set OutMail = OutApp.CreateItem(0) 
     On Error Resume Next 
     With OutMail 
      .To = cell.Value 
      .Subject = "Reminder" 
      .Body = "Dear " & Cells(cell.Row, "A").Value _ 
        & vbNewLine & vbNewLine & _ 
        "Please contact us to discuss bringing " & _ 
        "your account up to date" 
      'You can add files also like this 
      '.Attachments.Add ("C:\test.txt") 
      .Send 'Or use Display 
     End With 
     On Error GoTo 0 
     Set OutMail = Nothing 
    End If 
Next cell 
cleanup: 
Set OutApp = Nothing 
Application.ScreenUpdating = True 
End Sub 

ありがとうございます！たぶん、このような

Answer 1

...

Sub Test1() 
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm 
'Working in Office 2000-2016 
Dim OutApp As Object 
Dim OutMail As Object 
Dim Rng As Range 

Application.ScreenUpdating = False 
Set OutApp = CreateObject("Outlook.Application") 

On Error GoTo cleanup 
For Each Rng In Columns("B").Cells.SpecialCells(xlCellTypeConstants).Areas 
    If Rng.cell(2).Value Like "?*@?*.?*" And _ 
     LCase(Rng.Cells(3).Value) = "yes" Then 

     Set OutMail = OutApp.CreateItem(0) 
     On Error Resume Next 
     With OutMail 
      .To = Rng.cell(2).Value 
      .Subject = "Reminder" 
      .Body = "Dear " & Rng.cell(1).Value _ 
        & vbNewLine & vbNewLine & _ 
        "Please contact us to discuss bringing " & _ 
        "your account up to date" 
      'You can add files also like this 
      '.Attachments.Add ("C:\test.txt") 
      .Send 'Or use Display 
     End With 
     On Error GoTo 0 
     Set OutMail = Nothing 
    End If 
Next Rng 
cleanup: 
Set OutApp = Nothing 
Application.ScreenUpdating = True 
End Sub 

上記のコードは、B1 =空白、B2 =名前、B3 =電子メールアドレスと言うことを前提とし、B4 =はい/いいえとB5 =ブランク。あなたが名前や電子メールが1行目と2行目にあることを意味する場合は、列B

Answer 2

で同じ順序で、レコードの各種設定を有していてもよく、列ごとに1人が、この変更は行う必要があります。

For Each cell In Rows(2).Cells.SpecialCells(xlCellTypeConstants) 
    If cell.Value Like "?*@?*.?*" And LCase(cell.offset(1).Value) = "yes" Then 
     ' .... 
     .To = cell.Value 
     .Body = "Dear " & cell.offset(-1).Value 
     ' ...