H
horsetransport
Hello,
Below is what I "Know how to do" but it doesn't accomplish what I want
I have table called sndmail fields that matter useremail and mailsent
I need to get the sendmessage to loop through to EOF and only send
emails to those with mailsent field "NO"
I know how to get access to send emails using:
Option Explicit
Sub sbSendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
On Error GoTo ErrorMsgs
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message. Substitute
' your names here.
Set objOutlookRecip = .Recipients.Add("(e-mail address removed)")
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip =
..Recipients.Add("(e-mail address removed)")
objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "Last test." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
ErrorMsgs:
If Err.Number = "287" Then
'MsgBox "You clicked No to the Outlook security warning. " & _
"Rerun the procedure and click Yes to access e-mail" & _
"addresses to send your message. For more information, & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp. " "
Else
'MsgBox Err.Number, Err.Description'
End If
End Sub
I also found this that is supposed to perform Exactly what I want but
it bombs with 'improper use of my and other errors PLEASE help:
Private Sub emailList_Click()
' Loop through a email list generate messages one at a time
Dim dbs As Database, whereStr As String
Dim rstMail As Recordset, UserEmail As Variant
Dim postIt As Integer, UserName As Variant
Dim UserCompany As Variant, UserCountry As Variant
Dim UserComments As Variant, AccessVersion As Variant
Dim EmailDownload As Variant
If Not IsNull(Me!TrialEmail) Then
' Just do a single trial email
whereStr = " where userEmail = '" & Me!TrialEmail & "'"
Me!TrialEmail = Null
Else
' Email the list one at a time
whereStr = " where not emailSent "
End If
' Open the database object and select users names that havent been sent
yet
Set dbs = CurrentDb
Set rstMail = dbs.OpenRecordset("select * from softwareUsers " &
whereStr)
If rstMail.RecordCount = 0 Then GoTo exitCmdUserDetails
rstMail.MoveFirst
Do Until rstMail.EOF ' Begin loop
postIt = MsgBox(UserName & " " & rstMail!UserEmail & _
" ... " & rstMail!UserName & " ... " & _
rstMail!UserCompany, vbYesNoCancel, _
"Email The Following"
If postIt = vbYes Then
' Output the message as email. Build a complete email message
' from the user detail and the message on the output form
' Place the user comments at the bottom so that you can refer
' to them for that personal message !
DoCmd.SendObject acSendNoObject, , acFormatTXT, _
rstMail!UserEmail, , , Me![SubjectReq], _
Me![GreetingReq] & " " & rstMail!UserName & _
Chr(10) & Chr(10) & Me![Instructions] & _
Chr(10) & Chr(10) & rstMail!UserComments
' Update the email sent box
rstMail.Edit
rstMail("EmailSent") = True
rstMail.Update
Else
exitCmdUserDetails:
rstMail.Close
Exit Sub
End Sub
Thankyou,
Susan
Below is what I "Know how to do" but it doesn't accomplish what I want
I have table called sndmail fields that matter useremail and mailsent
I need to get the sendmessage to loop through to EOF and only send
emails to those with mailsent field "NO"
I know how to get access to send emails using:
Option Explicit
Sub sbSendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
On Error GoTo ErrorMsgs
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message. Substitute
' your names here.
Set objOutlookRecip = .Recipients.Add("(e-mail address removed)")
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip =
..Recipients.Add("(e-mail address removed)")
objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "Last test." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
ErrorMsgs:
If Err.Number = "287" Then
'MsgBox "You clicked No to the Outlook security warning. " & _
"Rerun the procedure and click Yes to access e-mail" & _
"addresses to send your message. For more information, & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp. " "
Else
'MsgBox Err.Number, Err.Description'
End If
End Sub
I also found this that is supposed to perform Exactly what I want but
it bombs with 'improper use of my and other errors PLEASE help:
Private Sub emailList_Click()
' Loop through a email list generate messages one at a time
Dim dbs As Database, whereStr As String
Dim rstMail As Recordset, UserEmail As Variant
Dim postIt As Integer, UserName As Variant
Dim UserCompany As Variant, UserCountry As Variant
Dim UserComments As Variant, AccessVersion As Variant
Dim EmailDownload As Variant
If Not IsNull(Me!TrialEmail) Then
' Just do a single trial email
whereStr = " where userEmail = '" & Me!TrialEmail & "'"
Me!TrialEmail = Null
Else
' Email the list one at a time
whereStr = " where not emailSent "
End If
' Open the database object and select users names that havent been sent
yet
Set dbs = CurrentDb
Set rstMail = dbs.OpenRecordset("select * from softwareUsers " &
whereStr)
If rstMail.RecordCount = 0 Then GoTo exitCmdUserDetails
rstMail.MoveFirst
Do Until rstMail.EOF ' Begin loop
postIt = MsgBox(UserName & " " & rstMail!UserEmail & _
" ... " & rstMail!UserName & " ... " & _
rstMail!UserCompany, vbYesNoCancel, _
"Email The Following"
If postIt = vbYes Then
' Output the message as email. Build a complete email message
' from the user detail and the message on the output form
' Place the user comments at the bottom so that you can refer
' to them for that personal message !
DoCmd.SendObject acSendNoObject, , acFormatTXT, _
rstMail!UserEmail, , , Me![SubjectReq], _
Me![GreetingReq] & " " & rstMail!UserName & _
Chr(10) & Chr(10) & Me![Instructions] & _
Chr(10) & Chr(10) & rstMail!UserComments
' Update the email sent box
rstMail.Edit
rstMail("EmailSent") = True
rstMail.Update
Else
exitCmdUserDetails:
rstMail.Close
Exit Sub
End Sub
Thankyou,
Susan