發送一封包含Excel過濾器中所有行的電子郵件

Question

此VBA代碼自動從Excel發送電子郵件。

我能做些什麼來發送一個電子郵件與不同行中的數據？

該代碼正在採取單獨的行和發送電子郵件，但我想通過位於不同行中的相同信息進行過濾，並在一封電子郵件中發送所有這些行。

Sub SendEmail(what_address As String, subject_line As String, mail_body As 
String) 
' 
' SendEmail Macro 
' 

'  
Dim olApp As Outlook.Application 
Set olApp = CreateObject("Outlook.Application") 

Dim olMail As Outlook.MailItem 
Set olMail = olApp.CreateItem(olMailItem) 

olMail.To = what_address 
olMail.Subject = subject_line 
olMail.Body = mail_body 
olMail.Send 

End Sub 


Sub SendMassEmail() 

row_number = 6 

Do 
DoEvents 
row_number = row_number + 1 
Dim mail_body_message As String 
Dim Invoice_no As String 
Dim Customer_name As String 
Dim Due_Date As String 
Dim Foreign_amount As String 

mail_body_message = Worksheets("Sheet").Range("N7").Value 
Invoice_no = Worksheets("Sheet").Range("D" & row_number).Value 
Customer_name = Worksheets("Sheet").Range("E" & row_number).Value 
Due_Date = Worksheets("Sheet").Range("F" & row_number).Value 
Foreign_amount = Worksheets("Sheet").Range("J" & row_number).Value 
mail_body_message = Replace(mail_body_message, "replace_Invoice_here", 
Invoice_no) 
mail_body_message = Replace(mail_body_message, "replace_customer_here", 
Customer_name) 
mail_body_message = Replace(mail_body_message, "replace_DueDate_here", 
Due_Date) 
mail_body_message = Replace(mail_body_message, "replace_ 
ForeignAmount_here", Foreign_amount) 

MsgBox mail_body_message 
Call SendEmail(Worksheets("Sheet").Range("K" & row_number), "Outstanding 
Invoices", mail_body_message) 

Loop Until row_number = 227 
MsgBox "Complete!" 

End Sub 

Answer 1

你可以換你的電子郵件在一個簡單的，如果statment：

Do 
DoEvents 
If Rows(row_number).EntireRow.Hidden = False Then 
    'Your email function 
End If 
row_number = row_number + 1 
Loop Until row_number = 227 

這樣，如果你的行被隱藏（即過濾），將跳過該行。我將row_number移動到了最後，假設您從第6行開始。這將防止代碼跳過第6行，因爲第7行被隱藏了。