Question

当前在Excel中处理订单，我一直无法通过宏按钮发送电子邮件。

现在，我已经在网上看到很多“如何在Excel中使用VBA发送电子邮件”的信息，而且我了解它们的作用。

我的问题是我希望电子邮件正文不仅显示电子邮件的主体，而且我希望能够将一个随机数值放入一个单元格中，然后宏将其提取并将其与文本一起转储特定于该单元格。

例如，订购表中有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符号“＆”的位置。

任何人都可以指出我如何做到这一点/适应当前教程以获得所需结果的大致方向吗？

编辑：似乎我所使用的表单有点误解，所以这是当前设置： enter image description here

我想通过按下订购按钮来实现：从数量列中获取与类型列中每个单板相对应的单元格值。

并将这些值放入电子邮件的主体中。至于特定文本，例如逗号等，我当时想的更像是if语句格式，例如如果B3具有值&& B4具有值，但B5和B6 == 0，则在电子邮件正文（B3）“（ref no）” +“＆” +（B4）“（ref no）”

中发布

依此类推，基于其中任何一个单元格是否具有值。我既不要求将文本放置在其他单元格中，例如包含“我想要”的单元格J7等。将直接添加到VBA脚本中的那种类型的文本。

@BBRK-关于我对您的回答的评论，这是我通过更改邮件正文的意思：

  xMailBody = "Hi <NAME>" & vbNewLine & vbNewLine & _
              "I'd like to order" & vbNewLine & _
              "Kind Regards"
                  On Error Resume Next

此代码显示如下：

实际上，我希望更改A列中正在引用的文本，并用硬编码的参考号代替该文本，该参考号将与我与供应商的订单相对应。

我也想更改“ Vibro 0”的位置，并将其移动到我已经说过要订购但不显示在当前行旁边的“亲切问候”旁边的位置， “部分。

@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

Answer 1

好吧，您可以将文本和数字组合在一起以获得所需的内容：

=A1&" "&A2&" "&A3

哪里单元格A1包含“我想要” 单元格A2包含值100 单元格A3包含“可变电阻器”

其结果是：我想要100个可变电阻器

Answer 2

根据您的解释，我在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

根据需要进行修改。希望我能帮到你。

我已根据您的需要编辑了代码。问题在于您在处理之前添加了“问候”文本。

EDIT2：

通过验证检查任何行的金额列是否为空白

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 VBA-如何发送包含特定于某些单元格值的文本的电子邮件？

2 个答案: