Fatal编程技术网
  • vba/
  • 电子邮件选项嵌入在提交按钮Excel VBA中

电子邮件选项嵌入在提交按钮Excel VBA中

vba excel

电子邮件选项嵌入在提交按钮Excel VBA中,vba,excel,Vba,Excel,我有这个提交按钮，我想向一个人发送一封关于质量检查状态的电子邮件通知。我想发生的是，如果质量检查器勾选了一个复选框，则所有选中复选框的标题都将包含在该复选框中。邮件正文，但我不知道如何编码。这是我的提交按钮代码 Private Sub CommandButton4_Click() If VERIFY_ENTRY = False Then Exit Sub Dim RowCounter As Long Dim rowCount As Long Dim ctrl As Cont

我有这个提交按钮，我想向一个人发送一封关于质量检查状态的电子邮件通知。我想发生的是，如果质量检查器勾选了一个复选框，则所有选中复选框的标题都将包含在该复选框中。邮件正文，但我不知道如何编码。这是我的提交按钮代码

Private Sub CommandButton4_Click()
If VERIFY_ENTRY = False Then Exit Sub
Dim RowCounter  As Long
Dim rowCount    As Long
Dim ctrl        As Control
Dim Score       As Double
Dim num As String

Dim OutMail As Object
Dim strbody1 As String
Dim OutApp As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

RowCounter = 0
Score = 1

For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
    Case Is = "CheckBox"
        If Me.Controls(ctrl.Name).Value = True Then Score = Score - GETSCORE(Me.Controls(ctrl.Name).Name)
    End Select
Next ctrl
Me.TextBox6.Value = Format(Score, "Percent")

If MsgBox("Submit RFP results?", vbQuestion + vbYesNo, "") = vbNo Then GoTo endmacro

'Data Sheet Transfer
rowCount = Worksheets("Quality Database").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Quality Database").Range("A" & rowCount + 1)

    .Offset(RowCounter, 0).Value = Now()
    .Offset(RowCounter, 1).Value = Me.TextBox2.Value
    .Offset(RowCounter, 2).Value = Me.ComboBox1.Value
    .Offset(RowCounter, 3).Value = Me.ComboBox2.Value
    .Offset(RowCounter, 4).Value = Me.ComboBox3.Value
    .Offset(RowCounter, 6).Value = "Initial prep/load"

    .Offset(RowCounter, 9).Value = Me.ComboBox4.Value

    .Offset(RowCounter, 10).Value = Round(Score * 100, 2)
    .Offset(RowCounter, 11).Value = Format(Me.TextBox3.Value, "hh:mm:ss")    'Start Time
    .Offset(RowCounter, 12).Value = Format(Me.TextBox4.Value, "hh:mm:ss")   'End Time
    .Offset(RowCounter, 13).Value = Format(Me.TextBox5.Value, "hh:mm:ss")   'Time Spent
    .Offset(RowCounter, 13).NumberFormat = "hh:mm:ss"

    ' Attributes Target
    For Each ctrl In Me.Controls
        Select Case TypeName(ctrl)
        Case Is = "CheckBox"
            If Me.Controls(ctrl.Name).Value = True Then
            'if not other checkbox
            If Me.Controls(ctrl.Name).Caption <> "Other" Then
             .Offset(RowCounter, 7).Value = vbCrLf & Me.Controls(ctrl.Name).Caption
                RowCounter = RowCounter + 1
                Else
                'get number from checkbox name
                num = Mid(ctrl.Name, 9)
                .Offset(RowCounter, 7).Value = vbCrLf & Me.Controls(ctrl.Name).Caption
                .Offset(RowCounter, 8).Value = Me.Controls("Textbox" & num).Value
                RowCounter = RowCounter + 1
                End If
            End If
        End Select
    Next ctrl
    If RowCounter = 0 Then .Offset(RowCounter, 7).Value = "Everything was Completed Satisfactory!"

    If Me.ComboBox4.Value = "Pending - Team Meeting" Then
   .Offset(RowCounter, 7).Value = ""
   .Offset(RowCounter, 10).Value = ""
   End If
   If Me.ComboBox4.Value = "Pending - 1st Break" Then
   .Offset(RowCounter, 7).Value = ""
   .Offset(RowCounter, 10).Value = ""
   End If
   If Me.ComboBox4.Value = "Pending - Lunch Break" Then
   .Offset(RowCounter, 7).Value = ""
   .Offset(RowCounter, 10).Value = ""
   End If
   If Me.ComboBox4.Value = "Pending - 2nd Break" Then
   .Offset(RowCounter, 7).Value = ""
   .Offset(RowCounter, 10).Value = ""
   End If
   If Me.ComboBox4.Value = "Pending - Coaching" Then
   .Offset(RowCounter, 7).Value = ""
   .Offset(RowCounter, 10).Value = ""
   End If

End With

'MessageBox
 MsgBox "Data added", vbOKOnly + vbInformation, ""
endmacro:
'Clear Data

If Me.ComboBox4.Value = "Completed" Then ' Enable Email Notification

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

       With OutMail
        .Display
        If Me.ComboBox1.Value = "Name1" Then
        .To = "name@email`enter code here`.com"
        End If
        If Me.ComboBox1.Value = "Name2" Then
        .To = "name@email.com"
        End If
        If Me.ComboBox1.Value = "Name3 " Then
        .To = "name@email.com"
        End If
        .CC = ""
        .BCC = ""
        .Subject = TextBox2.Value & " - Review Completed & " & Now()
        .Body = "Hi," & vbCrLf & vbCrLf & "Please see comment below"
        .Display 'change to .send if you want the email sent automatically

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

    Set OutMail = Nothing
    Set OutApp = Nothing

INIT_FORM
Me.TextBox2.SetFocus

'Save worksheet
 ThisWorkbook.Save



End If
End Sub

Private子命令按钮4\u单击（）
如果VERIFY_ENTRY=False，则退出Sub
暗排计数器与长排计数器相同
暗行数与长行数相同
按ctrl键作为控件
双杀
Dim num作为字符串
将邮件变暗为对象
作为字符串的Dim strbody1
Dim OutApp作为对象
像弦一样暗的链子
Set-OutApp=CreateObject（“Outlook.Application”）
Set-OutMail=OutApp.CreateItem（0）
行计数器=0
分数=1
对于Me.Controls中的每个ctrl键
选择案例类型名称（ctrl）
Case Is=“CheckBox”
如果Me.Controls（ctrl.Name）.Value=True，那么Score=Score-GETSCORE（Me.Controls（ctrl.Name）.Name）
结束选择
下一个ctrl键
Me.TextBox6.Value=格式（分数，“百分比”）
如果MsgBox（“提交RFP结果？”，vbQuestion+vbYesNo，”）=vbNo，则转到endmacro
“数据表传输”
rowCount=工作表（“质量数据库”）.Range（“A1”）.CurrentRegion.Rows.Count
带有工作表（“质量数据库”）。范围（“A”和行数+1）
.Offset（行计数器，0）.Value=Now（）
.Offset（行计数器，1）.Value=Me.TextBox2.Value
.Offset（行计数器，2）.Value=Me.ComboBox1.Value
.Offset（行计数器，3）.Value=Me.ComboBox2.Value
.Offset（行计数器，4）.Value=Me.ComboBox3.Value
.Offset（行计数器，6）.Value=“初始准备/加载”
.Offset（行计数器，9）.Value=Me.ComboBox4.Value
.偏移量（行计数器，10）。值=四舍五入（分数*100，2）
.Offset（RowCounter，11）.Value=格式（Me.TextBox3.Value，“hh:mm:ss”）'开始时间
.Offset（行计数器，12）.Value=格式（Me.TextBox4.Value，“hh:mm:ss”）'结束时间
.Offset（RowCounter，13）.Value=Format（Me.TextBox5.Value，“hh:mm:ss”）所用的时间
.Offset（行计数器，13）.NumberFormat=“hh:mm:ss”
'属性目标
对于Me.Controls中的每个ctrl键
选择案例类型名称（ctrl）
Case Is=“CheckBox”
如果Me.Controls（ctrl.Name）.Value=True，则
'如果不是其他复选框
如果Me.Controls（ctrl.Name）.Caption“Other”则
.Offset（行计数器，7）.Value=vbCrLf&Me.Controls（ctrl.Name）.Caption
行计数器=行计数器+1
其他的
'从复选框名称获取编号
num=Mid（ctrl.Name，9）
.Offset（行计数器，7）.Value=vbCrLf&Me.Controls（ctrl.Name）.Caption
.Offset（RowCounter，8）.Value=Me.Controls（“Textbox”&num）.Value
行计数器=行计数器+1
如果结束
如果结束
结束选择
下一个ctrl键
如果RowCounter=0，则.Offset（RowCounter，7）.Value=“一切都已圆满完成！”
如果Me.ComboBox4.Value=“待定-团队会议”，则
.Offset（行计数器，7）。Value=“”
.Offset（行计数器，10）.Value=“”
如果结束
如果Me.combox4.Value=“待定-第一次中断”，则
.Offset（行计数器，7）。Value=“”
.Offset（行计数器，10）.Value=“”
如果结束
如果Me.ComboBox4.Value=“待定-午休”，则
.Offset（行计数器，7）。Value=“”
.Offset（行计数器，10）.Value=“”
如果结束
如果Me.ComboBox4.Value=“待定-第二次中断”，则
.Offset（行计数器，7）。Value=“”
.Offset（行计数器，10）.Value=“”
如果结束
如果Me.ComboBox4.Value=“待定-辅导”，则
.Offset（行计数器，7）。Value=“”
.Offset（行计数器，10）.Value=“”
如果结束
以
'消息框
MsgBox“已添加数据”，vbOKOnly+vbInformation“
endmacro：
"数据清晰",
如果Me.ComboBox4.Value=“已完成”，则“启用电子邮件通知”
应用
.EnableEvents=False
.ScreenUpdate=False
以
发邮件
.展示
如果Me.ComboBox1.Value=“Name1”，则
.To=”name@email`在此处输入代码“.com”
如果结束
如果Me.ComboBox1.Value=“Name2”，则
.To=”name@email.com"
如果结束
如果Me.ComboBox1.Value=“Name3”，则
.To=”name@email.com"
如果结束
.CC=“”
.BCC=“”
.Subject=TextBox2.Value&“-Review Completed&“&Now（）
.Body=“嗨，&vbCrLf&vbCrLf&”请参见下面的评论”
.显示“更改为。如果希望自动发送电子邮件，请发送”
以
应用
.EnableEvents=True
.ScreenUpdate=True
以
发送邮件=无
设置应用程序=无
初始形式
Me.TextBox2.SetFocus
'保存工作表
此工作簿。保存
如果结束
端接头
这将从表单上的每个选中复选框中提取标题

该函数使用a来检查每个控件。我曾经用新行分隔复选框，这会使最后的文本更容易阅读

' Builds and returns the email body.
Private Function GetMailBody() As String
    Dim i As Integer            ' Counts number of selected checkboxes.
    Dim mailBody As String      ' Build the email message body here.
    Dim cntl As Control         ' Used to loop over controls, looking for checkboxes.

    ' Add body.
    For Each cntl In Me.Controls

        ' We only want checkboxes.
        If TypeName(cntl) = "CheckBox" Then

            ' Append selected boxes caption to mailBody.
            If cntl.Value = True Then 
                i = i + 1
                mailBody = mailBody & vbCrLf & cntl.Caption
            End If
        End If
    Next

    ' Update body, based on count of selected items.
    If i > 1 Then

        mailBody = "Opening text" & vbCrLf & mailBody & vbCrLf & "Closing text"
    Else 

        mailBody = "No items selected."
    End If
    GetMailBody = mailBody
End Function
要使用此功能，请更换线路

.Body = "Hi," & vbCrLf & vbCrLf & "Please see comment below"
与

在现有代码中

编辑
更新了代码，以在未选择任何项目时包含可选文本。

我很清楚您的处境。你能包括你当前得到的输出和你想要的输出吗？实际上我得到的唯一结果是.Body部分的模板消息，其中是Hi，请参阅下面的评论。正文中的附加消息应该是在所有复选框上勾选的所有标题。当然，我想说的是谢谢你；我不清楚你被困在哪里了。我关于事情不明的信息不清楚。哦，真可惜。看起来您已经创建了几个变量来构建主体（
strobody
，
strobody1
），但是您没有在任何地方使用这些变量。是不是因为你不知道怎么做？或者你是在问如何访问复选框的标题？是的，关于如何在电子邮件正文中包含复选框的标题，很抱歉，我忘记删除这些变量。这太神奇了，现在我得到了我想要的结果。如果没有支票怎么办 
.Body = GetMailBody()