发送一封包含Excel过滤器中所有行的电子邮件

时间:2017-04-25 15:59:57

标签: excel vba excel-vba outlook

此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

1 个答案:

答案 0 :(得分:0)

您可以使用简单的if语句包装电子邮件:

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

这样,如果您的行被隐藏(即过滤),它将跳过该行。假设您从第6行开始,我将row_number移动到最后。这将阻止代码跳过第6行,因为第7行被隐藏了。