Eine Nachricht an jede Person in einem Bereich senden (Zeile)

Question

Ich möchte um Hilfe bitten, wie ich Ron de Bruins Code von Spalte zu Zeile ändern kann (zB Zeile 1 enthält Name; Zeile 2 E-Mail; Zeile 3 entspricht entweder ja oder Nein).

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 

Vielen Dank im Voraus!

Answer 1

wie es andere ...

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 

Der obige Code wird davon ausgegangen, dass B1 = leer, B2 = Name, B3 = E-Mail-Adresse, B4 = Ja/Nein und B5 = Blank sagen. Sie können verschiedene Reihe von Datensätzen in der gleichen Reihenfolge, in Spalte B

Answer 2

haben Wenn Sie meinen, dass die Namen und E-Mails sind in den Zeilen 1 und 2, eine Person pro Spalte, dann sollte diese Modifikation tun:

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 
     ' ...