Excel VBA - 如何发送包含特定单元格值的文本的电子邮件？
Excel VBA - How can I send email with text specific to certain cell values?
目前正在 Excel 中处理订单，我一直坚持通过宏按钮发送电子邮件。
现在我在网上看到了很多 "how to send email using VBA in Excel"，我明白他们在说什么。
我的问题是我希望电子邮件正文不仅显示电子邮件的主体，而且我希望能够在一个单元格中放入一个随机数值，宏会拾取它并将这个单元格值一起转储带有特定于该单元格的文本。
例如订购单上有4块电路板我可以订购。现在这些将由 A、B、C 和 D
代表
如果我在每个电路板的数量单元格中输入 100，然后单击订购按钮。
以下电子邮件将如下所示：
Dear <Name>
I'd like to order 100 of A, 100 of B, 100 of C & 100 of D
Kind Regards,
<Name>
同时，如果突然在下一个订单中我想下订单，我只在 A 中放置 20 个，在 C 中放置 60 个，电子邮件将更改以反映此更改：
Dear <Name>
I'd like to order 20 of A & 60 of C
Kind Regards,
<Name>
这些更改是逗号、句号和 et 符号“&”的位置。
任何人都可以指出我如何做 this/adapt 当前教程以获得我需要的结果的大体方向？
编辑：我所使用的表格似乎有点误解，所以这是当前的设置：
我想通过按下订单按钮实现的目标：
从与类型列中每个单独的板相对应的数量列中获取单元格值。
并将这些值纳入电子邮件的主体。
关于逗号等特定文本。我更像是一种 if 语句格式，例如如果 B3 有值 && B4 有值但 B5 和 B6 == 0 那么 post 在电子邮件正文 (B3)"(ref no)"+" & " + (B4)"(ref no)"
等等基于这些单元格中的任何一个是否具有值。
我不要求将文本放置在其他单元格中，例如包含 "I would like" 等的单元格 J7。我将直接将这种类型的文本添加到 VBA 脚本中。
@BBRK - 关于我对你的回答的评论，这就是我更改邮件正文的意思：
xMailBody = "Hi <NAME>" & vbNewLine & vbNewLine & _
"I'd like to order" & vbNewLine & _
"Kind Regards"
On Error Resume Next
这段代码显示如下：
实际上，我希望更改 A 列中引用的文本，并将其替换为硬编码参考号，该参考号将与我与供应商的订单相对应。
我还想更改“Vibro 的 0”的位置，并将其移动到我说过我想订购但不显示在当前位于 [= 旁边的下一行之后56=]节。
@BBRK 这里是当前全VBA:
Private Sub Board_Order()
Dim xMailBody As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim count_var As Integer
Dim arr() As String
Dim arr_val() As Integer
Dim great_count As Integer
Dim arr_now As Integer
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
arr_now = 0
'Gets the count of number of zeroes available in the B3 to last data filled row of that column.
great_count = Application.WorksheetFunction.CountIf(Range("B3:B6" & Range("B3").End(Excel.XlDirection.xlDown).Row), ">0")
xMailBody = "Hi <NAME>" & vbNewLine & vbNewLine & _
"I'd like to order" & vbNewLine & _
"Kind Regards"
On Error Resume Next
'If orders are there then will go for further processing.
If great_count <> 0 Then
'Resizes array according to the count
ReDim arr(0 To great_count - 1)
ReDim arr_val(0 To great_count - 1)
'Loops through the range and input product into the arr and it's value in arr_val
If great_count > 0 Then
For i = 3 To Range("B3").End(Excel.XlDirection.xlDown).Row
If Range("B" & i).Value > 0 Then
arr(arr_now) = Range("A" & i).Value
arr_val(arr_now) = Range("B" & i).Value
arr_now = arr_now + 1
End If
Next i
End If
'Looping through each element in the array to get the desired result.
If great_count = 1 Then
xMailBody = xMailBody + " " + CStr(arr_val(j)) + " of " + arr(j)
Else
For j = 0 To UBound(arr)
If j = 0 Then
xMailBody = xMailBody + " " + CStr(arr_val(j)) + " of " + arr(j)
ElseIf j = UBound(arr) Then
xMailBody = xMailBody + " & " + CStr(arr_val(j)) + " of " + arr(j)
Else
xMailBody = xMailBody + " , " + CStr(arr_val(j)) + " of " + arr(j)
End If
Next j
End If
End If
With xOutMail
.To = "marcbrooks991@hotmail.com"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
好吧，您可以将文本和数字组合在一起以获得您想要的结果：
=A1&" "&A2&" "&A3
在哪里
单元格 A1 包含 "I would like"
单元格 A2 包含值 100
单元格 A3 包含 "variable resistors"
结果是：
我要100个可变电阻
根据您的解释，我在Excel中开发了一个VBA方法。
这将帮助您生成所需的连接字符串。
在编辑器中复制并粘贴 Excel VBA 代码并尝试 运行 它。
Sub Generate_String()
Dim HTML_body As String
Dim count_var As Integer
Dim arr() As String
Dim arr_val() As Integer
Dim great_count As Integer
Dim arr_now As Integer
Dim xMailBody As String
Dim xOutApp As Object
Dim xOutMail As Object
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
arr_now = 0
'Gets the count of number of zeroes available in the B3 to last data filled row of that column.
great_count = Application.WorksheetFunction.CountIf(Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row), ">0")
HTML_body = "Hi <Name>," & vbnewline & vbnewline & "I'd like to order"
'If orders are there then will go for further processing.
If great_count <> 0 Then
'Resizes array according to the count
ReDim arr(0 To great_count - 1)
ReDim arr_val(0 To great_count - 1)
'Loops through the range and input product into the arr and it's value in arr_val
If great_count > 0 Then
For i = 3 To Range("B3").End(Excel.XlDirection.xlDown).Row
If Range("B" & i).Value > 0 Then
arr(arr_now) = Range("A" & i).Value
arr_val(arr_now) = Range("B" & i).Value
arr_now = arr_now + 1
End If
Next i
End If
'Looping through each element in the array to get the desired result.
If great_count = 1 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
Else
For j = 0 To UBound(arr)
If j = 0 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
ElseIf j = UBound(arr) Then
HTML_body = HTML_body + " & " + CStr(arr_val(j)) + " of " + arr(j)
Else
HTML_body = HTML_body + " , " + CStr(arr_val(j)) + " of " + arr(j)
End If
Next j
End If
Else
HTML_body = "No Orders"
End If
HTML_body = HTML_body & vbnewline & "Kind Regards" & vbnewline & "<Name>"
With xOutMail
.To = "marcbrooks991@hotmail.com"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = HTML_body
.Display 'or use .Send
End With
End Sub
根据您的需要进行修改。
希望我能帮到你。
我已经根据您的需要编辑了代码。问题是您在处理之前添加了 'Kind Regards' 文本。
编辑2：
通过验证检查任何行的金额列是否为空
Sub Generate_String()
Dim HTML_body As String
Dim count_var As Integer
Dim arr() As String
Dim arr_val() As Integer
Dim great_count As Integer
Dim arr_now As Integer
Dim rng_Body As Range
Dim xMailBody As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim validate_pass As Boolean
'Checks if the any of the range has blank values
'if blank value is found it will make validate_pass variable to false.
Set rng_Body = Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row)
validate_pass = True
For Each r In rng_Body
If Trim(r.Text) = "" Then
validate_pass = False
Exit For
End If
Next r
'If validate_pass variable is false then throws out error message.
'Else it will go through the normal procedure to sent out emails.
If validate_pass = False Then
MsgBox "Your appropriate error message if any of the amount value found blank", vbCritical
Else
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
arr_now = 0
Set rng_Body = Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row)
'Gets the count of number of zeroes available in the B3 to last data filled row of that column.
great_count = Application.WorksheetFunction.CountIf(Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row), ">0")
HTML_body = "Hi <Name>," & vbNewLine & vbNewLine & "I'd like to order"
'If orders are there then will go for further processing.
If great_count <> 0 Then
'Resizes array according to the count
ReDim arr(0 To great_count - 1)
ReDim arr_val(0 To great_count - 1)
'Loops through the range and input product into the arr and it's value in arr_val
If great_count > 0 Then
For i = 3 To Range("B3").End(Excel.XlDirection.xlDown).Row
If Range("B" & i).Value > 0 Then
arr(arr_now) = Range("A" & i).Value
arr_val(arr_now) = Range("B" & i).Value
arr_now = arr_now + 1
End If
Next i
End If
'Looping through each element in the array to get the desired result.
If great_count = 1 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
Else
For j = 0 To UBound(arr)
If j = 0 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
ElseIf j = UBound(arr) Then
HTML_body = HTML_body + " & " + CStr(arr_val(j)) + " of " + arr(j)
Else
HTML_body = HTML_body + " , " + CStr(arr_val(j)) + " of " + arr(j)
End If
Next j
End If
Else
HTML_body = "No Orders"
End If
HTML_body = HTML_body & vbNewLine & "Kind Regards" & vbNewLine & "<Name>"
With xOutMail
.To = "marcbrooks991@hotmail.com"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = HTML_body
.Display 'or use .Send
End With
MsgBox "Order Email has been Sent"
End If
End Sub
目前正在 Excel 中处理订单，我一直坚持通过宏按钮发送电子邮件。
现在我在网上看到了很多 "how to send email using VBA in Excel"，我明白他们在说什么。
我的问题是我希望电子邮件正文不仅显示电子邮件的主体，而且我希望能够在一个单元格中放入一个随机数值，宏会拾取它并将这个单元格值一起转储带有特定于该单元格的文本。
例如订购单上有4块电路板我可以订购。现在这些将由 A、B、C 和 D
代表如果我在每个电路板的数量单元格中输入 100，然后单击订购按钮。
以下电子邮件将如下所示：
Dear <Name>
I'd like to order 100 of A, 100 of B, 100 of C & 100 of D
Kind Regards,
<Name>
同时，如果突然在下一个订单中我想下订单，我只在 A 中放置 20 个，在 C 中放置 60 个，电子邮件将更改以反映此更改：
Dear <Name>
I'd like to order 20 of A & 60 of C
Kind Regards,
<Name>
这些更改是逗号、句号和 et 符号“&”的位置。
任何人都可以指出我如何做 this/adapt 当前教程以获得我需要的结果的大体方向？
编辑：我所使用的表格似乎有点误解，所以这是当前的设置：
我想通过按下订单按钮实现的目标： 从与类型列中每个单独的板相对应的数量列中获取单元格值。
并将这些值纳入电子邮件的主体。 关于逗号等特定文本。我更像是一种 if 语句格式，例如如果 B3 有值 && B4 有值但 B5 和 B6 == 0 那么 post 在电子邮件正文 (B3)"(ref no)"+" & " + (B4)"(ref no)"
等等基于这些单元格中的任何一个是否具有值。 我不要求将文本放置在其他单元格中，例如包含 "I would like" 等的单元格 J7。我将直接将这种类型的文本添加到 VBA 脚本中。
@BBRK - 关于我对你的回答的评论，这就是我更改邮件正文的意思：
xMailBody = "Hi <NAME>" & vbNewLine & vbNewLine & _
"I'd like to order" & vbNewLine & _
"Kind Regards"
On Error Resume Next
这段代码显示如下：
实际上，我希望更改 A 列中引用的文本，并将其替换为硬编码参考号，该参考号将与我与供应商的订单相对应。
我还想更改“Vibro 的 0”的位置，并将其移动到我说过我想订购但不显示在当前位于 [= 旁边的下一行之后56=]节。
@BBRK 这里是当前全VBA:
Private Sub Board_Order()
Dim xMailBody As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim count_var As Integer
Dim arr() As String
Dim arr_val() As Integer
Dim great_count As Integer
Dim arr_now As Integer
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
arr_now = 0
'Gets the count of number of zeroes available in the B3 to last data filled row of that column.
great_count = Application.WorksheetFunction.CountIf(Range("B3:B6" & Range("B3").End(Excel.XlDirection.xlDown).Row), ">0")
xMailBody = "Hi <NAME>" & vbNewLine & vbNewLine & _
"I'd like to order" & vbNewLine & _
"Kind Regards"
On Error Resume Next
'If orders are there then will go for further processing.
If great_count <> 0 Then
'Resizes array according to the count
ReDim arr(0 To great_count - 1)
ReDim arr_val(0 To great_count - 1)
'Loops through the range and input product into the arr and it's value in arr_val
If great_count > 0 Then
For i = 3 To Range("B3").End(Excel.XlDirection.xlDown).Row
If Range("B" & i).Value > 0 Then
arr(arr_now) = Range("A" & i).Value
arr_val(arr_now) = Range("B" & i).Value
arr_now = arr_now + 1
End If
Next i
End If
'Looping through each element in the array to get the desired result.
If great_count = 1 Then
xMailBody = xMailBody + " " + CStr(arr_val(j)) + " of " + arr(j)
Else
For j = 0 To UBound(arr)
If j = 0 Then
xMailBody = xMailBody + " " + CStr(arr_val(j)) + " of " + arr(j)
ElseIf j = UBound(arr) Then
xMailBody = xMailBody + " & " + CStr(arr_val(j)) + " of " + arr(j)
Else
xMailBody = xMailBody + " , " + CStr(arr_val(j)) + " of " + arr(j)
End If
Next j
End If
End If
With xOutMail
.To = "marcbrooks991@hotmail.com"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
好吧，您可以将文本和数字组合在一起以获得您想要的结果：
=A1&" "&A2&" "&A3
在哪里 单元格 A1 包含 "I would like" 单元格 A2 包含值 100 单元格 A3 包含 "variable resistors"
结果是： 我要100个可变电阻
根据您的解释，我在Excel中开发了一个VBA方法。
这将帮助您生成所需的连接字符串。
在编辑器中复制并粘贴 Excel VBA 代码并尝试 运行 它。
Sub Generate_String()
Dim HTML_body As String
Dim count_var As Integer
Dim arr() As String
Dim arr_val() As Integer
Dim great_count As Integer
Dim arr_now As Integer
Dim xMailBody As String
Dim xOutApp As Object
Dim xOutMail As Object
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
arr_now = 0
'Gets the count of number of zeroes available in the B3 to last data filled row of that column.
great_count = Application.WorksheetFunction.CountIf(Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row), ">0")
HTML_body = "Hi <Name>," & vbnewline & vbnewline & "I'd like to order"
'If orders are there then will go for further processing.
If great_count <> 0 Then
'Resizes array according to the count
ReDim arr(0 To great_count - 1)
ReDim arr_val(0 To great_count - 1)
'Loops through the range and input product into the arr and it's value in arr_val
If great_count > 0 Then
For i = 3 To Range("B3").End(Excel.XlDirection.xlDown).Row
If Range("B" & i).Value > 0 Then
arr(arr_now) = Range("A" & i).Value
arr_val(arr_now) = Range("B" & i).Value
arr_now = arr_now + 1
End If
Next i
End If
'Looping through each element in the array to get the desired result.
If great_count = 1 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
Else
For j = 0 To UBound(arr)
If j = 0 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
ElseIf j = UBound(arr) Then
HTML_body = HTML_body + " & " + CStr(arr_val(j)) + " of " + arr(j)
Else
HTML_body = HTML_body + " , " + CStr(arr_val(j)) + " of " + arr(j)
End If
Next j
End If
Else
HTML_body = "No Orders"
End If
HTML_body = HTML_body & vbnewline & "Kind Regards" & vbnewline & "<Name>"
With xOutMail
.To = "marcbrooks991@hotmail.com"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = HTML_body
.Display 'or use .Send
End With
End Sub
根据您的需要进行修改。 希望我能帮到你。
我已经根据您的需要编辑了代码。问题是您在处理之前添加了 'Kind Regards' 文本。
编辑2：
通过验证检查任何行的金额列是否为空
Sub Generate_String()
Dim HTML_body As String
Dim count_var As Integer
Dim arr() As String
Dim arr_val() As Integer
Dim great_count As Integer
Dim arr_now As Integer
Dim rng_Body As Range
Dim xMailBody As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim validate_pass As Boolean
'Checks if the any of the range has blank values
'if blank value is found it will make validate_pass variable to false.
Set rng_Body = Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row)
validate_pass = True
For Each r In rng_Body
If Trim(r.Text) = "" Then
validate_pass = False
Exit For
End If
Next r
'If validate_pass variable is false then throws out error message.
'Else it will go through the normal procedure to sent out emails.
If validate_pass = False Then
MsgBox "Your appropriate error message if any of the amount value found blank", vbCritical
Else
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
arr_now = 0
Set rng_Body = Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row)
'Gets the count of number of zeroes available in the B3 to last data filled row of that column.
great_count = Application.WorksheetFunction.CountIf(Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row), ">0")
HTML_body = "Hi <Name>," & vbNewLine & vbNewLine & "I'd like to order"
'If orders are there then will go for further processing.
If great_count <> 0 Then
'Resizes array according to the count
ReDim arr(0 To great_count - 1)
ReDim arr_val(0 To great_count - 1)
'Loops through the range and input product into the arr and it's value in arr_val
If great_count > 0 Then
For i = 3 To Range("B3").End(Excel.XlDirection.xlDown).Row
If Range("B" & i).Value > 0 Then
arr(arr_now) = Range("A" & i).Value
arr_val(arr_now) = Range("B" & i).Value
arr_now = arr_now + 1
End If
Next i
End If
'Looping through each element in the array to get the desired result.
If great_count = 1 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
Else
For j = 0 To UBound(arr)
If j = 0 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
ElseIf j = UBound(arr) Then
HTML_body = HTML_body + " & " + CStr(arr_val(j)) + " of " + arr(j)
Else
HTML_body = HTML_body + " , " + CStr(arr_val(j)) + " of " + arr(j)
End If
Next j
End If
Else
HTML_body = "No Orders"
End If
HTML_body = HTML_body & vbNewLine & "Kind Regards" & vbNewLine & "<Name>"
With xOutMail
.To = "marcbrooks991@hotmail.com"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = HTML_body
.Display 'or use .Send
End With
MsgBox "Order Email has been Sent"
End If
End Sub