[英]Send email to recipients with (varying) multiple attachments based on criteria in columns
I am currently trying to write a macro where it will email multiple attachments to recipients depending on whether each column has an X next to their name.我目前正在尝试编写一个宏,它将根据每列的名称旁边是否有X将多个附件通过电子邮件发送给收件人。 I have the email addresses in column G and 11 different report names ranging from columns H:R .我在G列中有电子邮件地址,在H:R列中有 11 个不同的报告名称。
So far I've written a macro that will send an attachment ( Report 1 ) if email recipients have an X in column H , but I'm unsure how to write a macro so it will search columns H:R for X and send the corresponding reports (ie If an email recipient has an X in column H and column J then I want them to receive both Report 1 and Report 3 in the same email).到目前为止,我已经编写了一个宏,如果电子邮件收件人在H列中有一个X ,它将发送一个附件(报告 1 ),但我不确定如何编写一个宏,因此它将在H:R列中搜索X并发送相应的报告(即,如果电子邮件收件人在H列和J列中有X ,那么我希望他们在同一封电子邮件中同时收到报告 1和报告 3 )。
Sorry if my explanation is difficult to interpret.对不起,如果我的解释难以解释。
Any help is much appreciated非常感谢任何帮助
Private Sub CommandButton1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Contacts")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("G").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "H").Value) = "x" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Report 1"
.body = "Hi " & cell.Offset(0, -3).Value
'Link file path for attachment
.Attachments.Add ("C:\Users\smcelroy021218\Desktop\Email Macro Working.xlsm")
.Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
You don't say where the file paths come from: in this example I'm picking them up from the first row of your sheet (so from H1:R1).您没有说明文件路径的来源:在本例中,我从工作表的第一行(因此从 H1:R1)中提取它们。
Private Sub CommandButton1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, c As Range
Dim FileCell As Range
Dim rng As Range, rngAttach As Range
Set sh = Sheets("Contacts")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("G").Cells.SpecialCells(xlCellTypeConstants)
Set rngAttach = cell.Offset(0, 7).Resize(1, 11)
'EDIT: must have at least one attachment to create a mail
If cell.Value Like "?*@?*.?*" And _
Application.Countif(rngAttach, "x") > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Report 1"
.body = "Hi " & cell.Offset(0, -3).Value
'loop over H:R and check for "x"
For Each c In rngAttach.Cells
If LCase(Trim(c.Value)) = "x" Then
'pick up the file path from the top row of the sheet
.Attachments.Add sh.Cells(1, c.Column).Value
End If
Next c
.Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.