正在開發一個項目,如果滿足條件,該項目將向不同的人發送批量郵件。
狀況 :
- U 列包含最終狀態(開啟或 WIP)(如果關閉,則無論當前日期是否較大,都不會發送)
- Q 欄位包含關閉日期。與當前日期相比,如果少於則自動拍攝郵件給人們。
我曾嘗試使用 for 循環,但它使用相同的「收件者」和「副本」發送了 4 封郵件。並且不會去下一行比較。
單元格將 V2 與 Q2 進行比較,然後下一個循環 V3 與 Q3,並同時檢查單元格 U2 是否“開路”
先感謝您。
程式碼如下:
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
答案1
我認為這是因為你的循環
For i = 1 to 4
但你從不引用i
,所以它正在做一切四次。你應該像這樣使用它 -
If Sheets("Data").cells(21,1+i).Value2 = "Open" Or Sheets("Data").cells(21,1+i).Value2 = "WIP" And ...
我不完全確定你的第二部分if
指的是什麼,但你明白了要點。