使用Excel VBA创建具有特定值的行的Outlook电子邮件正文 [英] Create Outlook Email Body with rows having a particular value using Excel VBA

问题描述

我已经使用一个示例来创建代码，以使用按钮"(文件中的红色)从Excel(使用Outlook)发送电子邮件.

I've used an example to create code to send emails from Excel (with Outlook), using a "Button" (red in my file).

该代码有效.有一个预先选择的行[B1:K20]范围，借助 Application.InputBox 函数，可以手动对其进行修改.

The code works. There is a pre-selected range of rows [B1:K20], that can be manually modified thanks to the Application.InputBox function.

Sub MAIL()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim StrBodyIn, StrBodyEnd As String

StrBodyIn = "Bonjour," & "<br>" & _
           " " & "<br>" & _
          "Buongiorno," & "<br>"

StrBodyEnd = " " & "<br>" & _
             "Cordialement" & "<br>" & _
             " " & "<br>" & _
             Range("M2") & "<br>"

Set rng = Nothing

On Error Resume Next
Set rng = Sheets("TEST").Application.InputBox("Range", xTitleId, "B1:K20", Type:=8)
On Error GoTo 0

If rng Is Nothing Then
    MsgBox "ATTENZIONE!!!" & _
           vbNewLine & "Seleziona un range di celle valido.", vbOKOnly
    Exit Sub
End If

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

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

On Error Resume Next
With OutMail
    .To = "[e-mail]"
    .CC = ""
    .BCC = ""
    .Subject = "SITUATION"
    .HTMLBody = "<p style='font-family:calibri;font-size:16'>" & StrBodyIn & RangetoHTML(rng) & "<p style='font-family:calibri;font-size:16'>" & StrBodyEnd
    .Display 'or use .Send
End With
On Error GoTo 0

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

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

我想添加一个条件.

如果在"A"列中写有"X"符号，则应将选定的行范围复制到电子邮件的正文中.

在我的示例中，应复制n°1、2和n°5行.

In my example, rows n° 1, 2 and n° 5 should be copied.

推荐答案

这里的两个任务是分开的，因此我将这样编写它们.这就是我的方法.将您的潜艇分成两个逻辑过程.

The two tasks here are separate so I would code them as such. Here would be my approach. Separate your sub into two logical procedures.

1. 确定身体范围
2. 发送范围内的电子邮件

---

确定身体范围

将您的按钮链接到此宏.宏将接受输入并将其转换为单列范围(Column B).然后，我们将遍历所选范围，并查看Column A以确定是否存在x.如果存在x，我们将把范围调整为原始大小，并将其添加到单元格集合(Final)中.

---

Determine the body range

Link your button to this macro. The macro will take an input and convert it into a single column range (Column B). We will then loop through the selected range and look at Column A to determine if there is an x or not. If an x is present, we will resize the range back to it's original size and add it to a collection of cells (Final).

循环完成后，宏将执行以下操作之一:

Once the loop is complete, the macro will then do one of the following:

1. 如果范围为空，它将提示您的消息框并结束该子项(您的电子邮件宏从不启动)
2. 如果范围不为空，我们将调用您的EMAIL宏，并将范围传递给它.

1. If the range is empty, it will prompt your message box and end the sub (your email macro is never initiated)
2. If the range is not empty, we will call your EMAIL macro and pass the range along to it.

Sub EmailRange()

Dim Initial As Range, Final As Range, nCell As Range

On Error Resume Next
    Set Initial = Sheets("TEST").Application.InputBox("Range", xTitleId, "B1:K20", Type:=8)
On Error GoTo 0

For Each nCell In Initial.Resize(Initial.Rows.Count, 1)
    If nCell.Offset(, -1) = "X" Then
        If Not Final Is Nothing Then
            Set Final = Union(Final, nCell.Resize(1, Initial.Columns.Count))
        Else
            Set Final = nCell.Resize(1, Initial.Columns.Count)
        End If
    End If
Next nCell

If Not Final Is Nothing Then
    MAIL Final
Else
    MsgBox "ATTENZIONE!!!" & vbNewLine & "Seleziona un range di celle valido.", vbOKOnly
End If

End Sub

---

发送范围内的电子邮件

请注意，宏现在具有输入(在第一行上).如果调用了该子程序，则您无需再进行任何验证，因为这都是在原始子程序中完成的！

---

Send the email with the range

Notice that the macro now has an input (On first line). If the sub is called, you no longer need to validate anything since this was all done in the original sub!

Sub MAIL(Final as Range)

Dim OutApp As Object, OutMail As Object
Dim StrBodyIn As String, StrBodyEnd As String

StrBodyIn = "Bonjour," & "<br>" & " " & "<br>" & "Buongiorno," & "<br>"
StrBodyEnd = " " & "<br>" & "Cordialement" & "<br>" & " " & "<br>" & Range("M2") & "<br>"

Application.EnableEvents = False
Application.ScreenUpdating = False

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

    On Error Resume Next
        With OutMail
            .To = "[e-mail]"
            .CC = ""
            .BCC = ""
            .Subject = "SITUATION"
            .HTMLBody = "<p style='font-family:calibri;font-size:16'>" & StrBodyIn & RangetoHTML(Final) & "<p style='font-family:calibri;font-size:16'>" & StrBodyEnd
            .Display 'or use .Send
        End With
    On Error GoTo 0

  Set OutMail = Nothing
  Set OutApp = Nothing

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

这篇关于使用Excel VBA创建具有特定值的行的Outlook电子邮件正文的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！