Question

我对宏有一点问题。它目前工作正常，但我需要添加一些代码来执行以下操作，但不知道在什么时候添加它：

如果C列中的每个单元格都有一个空白单元格，要在同一行中查找电子邮件地址，但在M列中右侧有10列
在身体的开头“你好（B栏内容）
在电子邮件正文中，我希望宏能够插入F列中的内容，如下所示：“请选择以下选项（列F内容）

有关如何修改代码以包含这些选项的任何想法，请

感谢您的时间。

Sub Send_Email()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim cel As Range
    Dim SigString As String
    Dim Signature As String

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

 SigString = Environ("appdata") & _
                "\Microsoft\Signatures\GBS.txt"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    For Each cel In Range(("C2"), Range("C2").End(xlDown))
        strbody = "Hi there" & vbNewLine & vbNewLine & _
                "My name Is William, Please choose the following option ..." & vbNewLine & _
                "I work at Fair" & vbNewLine & _
                "Bye" & vbNewLine & _
                "WH"

        On Error Resume Next
        With OutMail
            .To = cel.Value
            .CC = cel.Offset(0, 10).Value
            '.BCC = ""
            .Subject = "Choose you plan"
            .Body = strbody & vbNewLine & vbNewLine & Signature
            .Display
            '.Attachments.Add ("C:\test.txt")
            '.Send
        End With
        On Error GoTo 0
    Next cel

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Answer 1

试试这个：

Sub Send_Email()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim cel As Range
    Dim SigString As String
    Dim Signature As String
    Dim lastrow As Long
    Set OutApp = CreateObject("Outlook.Application")


    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\GBS.txt"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    lastrow = Cells(Rows.Count, 3).End(xlUp).Row

    For Each cel In Range("C2:C" & lastrow)
        strbody = "Hi there" & cel.Offset(, -1) & vbNewLine & vbNewLine & _
                "My name Is William, Please choose the following option ..." & vbNewLine & _
                cel.Offset(, 3) & _
                "I work at Fair" & vbNewLine & _
                "Bye" & vbNewLine & _
                "WH"

        On Error Resume Next
        With OutApp.CreateItem(0)
            If cel.Value <> "" Then
               .To = cel.Value
               .CC = cel.Offset(0, 10).Value
            Else
               .To = cel.Offset(0, 10).Value & ", " & Join(Application.Index(cel.Offset(, -2).Resize(, 4).Value, 0), ", ")
            End If
            '.BCC = ""
            .Subject = "Choose you plan"
            .Body = strbody & vbNewLine & vbNewLine & Signature
            .Display
            '.Attachments.Add ("C:\test.txt")
            '.Send
        End With
        On Error GoTo 0
    Next cel


    Set OutApp = Nothing
End Sub

向电子邮件发送宏添加条件和可选输入

1 个答案: