☰

Senden von Massenmails mit Excel VBA

tag-icon • tag-icon vba microsoft-excel-2013 macros
Senden von Massenmails mit Excel VBA

Ich habe an einem Projekt gearbeitet, bei dem Massenmails an verschiedene Personen versendet werden, wenn die Bedingungen erfüllt sind.

Bedingungen :

  • Spalte U enthält den endgültigen Status (Offen oder In Arbeit) (wird nicht gesendet, wenn „Geschlossen“, unabhängig davon, ob das aktuelle Datum größer ist)
  • Spalte Q enthält das Schließungsdatum. Wenn dieses mit dem aktuellen Datum verglichen wird, werden den Personen automatisch E-Mails gesendet.

Ich habe versucht, dies mit einer For-Schleife zu tun, aber es werden 4 Mails mit demselben An- und CC-Code gesendet. Und es wird nicht zur nächsten Zeile zum Vergleichen gegangen.

Zellvergleich V2 mit Q2, dann nächste Schleife V3 mit Q3 und gleichzeitig prüfen, ob die Zelle U2 "Offen" hat

Vielen Dank im Voraus.

Code wie unten:

Sub Data_RoundedRectangle1_Click()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim StrBody As String



On Error Resume Next

For i = 1 to 4

If Sheets("Data").Range("U2:U6").Value2 = "Open" Or     Sheets("Data").Range("U2:U6").Value2 = "WIP" And (CDate(Cells(2, 17).Value) <     Now()) Then



        Set rng = Nothing
        On Error Resume Next
        'Only the visible cells in the selection
        Set rng = Selection.SpecialCells(xlCellTypeVisible)
        'You can also use a fixed range if you want
        Set rng = Sheets("Checklist").Range("A2:B25").SpecialCells(xlCellTypeVisible)
        On Error GoTo 0


        With Application
        .EnableEvents = False
        .ScreenUpdating = False
        End With

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        On Error Resume Next

With OutMail


        If Worksheets("Data").Cells(i, "C").Value2 = "Operation_Support" And Worksheets("Data").Cells(i, "E").Value2 = "Quality_Assurance" Then


     StrBody = "Hi," & "<br>" & _


.To = "a"

.CC = "b"
.BCC = ""
.Subject = ""
.HTMLBody = StrBody & RangetoHTML(rng)
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
.Display
'.Send

ElseIf Worksheets("Data").Cells(i, "C").Value = "Operation_Support" And Worksheets("Data").Cells(i, "E").Value = "Analytics" Then

StrBody = "Hi," & "<br>" & _
      "PFB the process details which requires your attention." & "<br>" & _
      "The review for this process has crossed over due." & "<br>" & _
      "Please ask the process owner to review the Process Manuals and Maps."     & "<br><br><br>"

.To = "c"

.CC = "d"
.BCC = ""
.Subject = "Process Manual and Maps Review is Overdue"
.HTMLBody = StrBody & RangetoHTML(rng)
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
.Display
'.Send

End If

    End With

    i = i + 1
    Exit For

    End If
End If

Next r

On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

Next x
End Sub

Bildbeschreibung hier eingeben

Antwort1

Ich denke, es liegt an deiner Schleife

For i = 1 to 4

Aber Sie verweisen nie darauf i, also ist es soallesviermal. Sie sollten es stattdessen so verwenden -

If Sheets("Data").cells(21,1+i).Value2 = "Open" Or Sheets("Data").cells(21,1+i).Value2 = "WIP" And ...

Ich bin nicht ganz sicher, worauf sich der zweite Teil Ihres ifKommentars bezieht, aber Sie verstehen, worum es geht.

verwandte Informationen