如果选中复选框,则尝试向人们发送电子邮件

时间:2017-05-03 16:40:51

标签: vba access-vba

我正在使用Access,Form和Subform,我正在尝试遍历复选框,如果选中它们,请向已签出的人发送电子邮件。

问题是我找不到方法或数据成员。 此行引发错误。 Me.qry_Ryan_Emails.Work_Email

Option Compare Database

Private Sub Command1_Click()

For Each ctrl In Me.qry_Ryan_Emails.Controls

    If TypeName(ctrl) = "CheckBox" Then
        If ctrl.Enabled = True Then
            'Debug.Print TypeName(ctrl)

            Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                eSubject = Me.Subject.Text
                eBody = Me.Message.Text

                On Error Resume Next

                With OutMail
                    .To = Me.qry_Ryan_Emails.Work_Email
                    .CC = ""
                    .BCC = ""
                    .Subject = eSubject
                    .BodyFormat = olFormatHTML
                    .Display
                    .HTMLBody = eBody & vbCrLf & .HTMLBody
                    '.Send
                End With

                On Error GoTo 0
                Set OutMail = Nothing
                Set OutApp = Nothing


        End If

    End If
Next ctrl

End Sub

最后,将所有电子邮件收件人连接成一封电子邮件并发送一封电子邮件而不是多封电子邮件会更好吗?这可能是一种更好的方法。任何想法,任何人?

2 个答案:

答案 0 :(得分:0)

这适合我。

Option Compare Database

Private Sub Command1_Click()

AllEmails = ""
For Each ctrl In Me.qry_Ryan_Emails.Controls

    If TypeName(ctrl) = "CheckBox" Then
        If ctrl.Enabled = True Then
            AllEmails = AllEmails & " " & Me!qry_Ryan_Emails.Form.Work_Email
        End If
    End If

Next ctrl

Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    eSubject = Me!Subject
    eBody = Me!Message

    On Error Resume Next

    With OutMail
        .To = AllEmails
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .BodyFormat = olFormatHTML
        .Display
        .HTMLBody = eBody & vbCrLf & .HTMLBody
        .Send
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

此行将所有电子邮件连接成一个字符串。

AllEmails = AllEmails & " " & Me!qry_Ryan_Emails.Form.Work_Email

然后我只发送一封电子邮件给小组。

此链接对于引用表单和子表单上的控件非常有用。

http://access.mvps.org/access/forms/frm0031.htm

答案 1 :(得分:0)

使用ListBox并在ListBox中选择多个项目,你可以做同样的事情。

Option Compare Database

Private Sub Command1_Click()
Dim varItem As Variant
Dim lngRow As Long
Dim strMsg As String

AllEmails = ""

With Me.List_Emails
    For lngRow = 0 To .ListCount - 1
        If .Selected(lngRow) Then
            AllEmails = AllEmails & .Column(2, lngRow)
        End If
    Next lngRow
End With


Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    eSubject = Me!Subject
    eBody = Me!Message

    On Error Resume Next

    With OutMail
        .To = AllEmails
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .BodyFormat = olFormatHTML
        .Display
        .HTMLBody = eBody & vbCrLf & .HTMLBody
        '.Send
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub