我正在使用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
最后,将所有电子邮件收件人连接成一封电子邮件并发送一封电子邮件而不是多封电子邮件会更好吗?这可能是一种更好的方法。任何想法,任何人?
答案 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
然后我只发送一封电子邮件给小组。
此链接对于引用表单和子表单上的控件非常有用。
答案 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