将条件和可选input添加到电子邮件发送macros

我有一个微观的macros观问题。 它现在正常工作，但我需要添加一些代码来执行以下操作，但不知道在什么时候添加它：

1. 如果对于C列中的每个单元格，都有一个空白单元格用于在同一行上查找电子邮件地址，而在列M中右侧则是10列

2. 在身体的开始“你好（列B内容）

3. 在电子邮件正文中，我希望macros插入F列中的内容，如下所示：“请select以下选项（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