|
 |
access thread: Please Help: Validate Email Address before sending
Message #1 by "George Oro" <george@c...> on Wed, 29 May 2002 18:56:56 +0400
|
|
Hi Guys,
Actually I have a table called tblMyContacts as the source if I'm sending an
email via access. The problem I encountered is, if I want to send to all my contacts using a loop, in between the process will stop
and I'm sure due to wrong email address. How can I
see which address is wrong and skip the error and continue till the end?
THIS IS NOT FOR SPAM MAIL!!!
Your help on the above matters is highly appreciated.
Cheers,
George
Message #2 by "John Ruff" <papparuff@c...> on Wed, 29 May 2002 08:23:25 -0700
|
|
Just before the .send in your code try add this:
' resolve each Recipient's name
For Each olookRecipient In .Recipients
olookRecipient.Resolve
If Not olookRecipient.Resolve Then
olookMsg.Display ' display any names that can't be
resolved
End If
Next
(The olookRecipient is Dim olookRecipient As Outlook.Recipient in this
sample)
You can also rem your On Error... statement to see where the code is
erring out.
John Ruff - The Eternal Optimist :-)
Always Looking for a Contract Opportunity
xxx.xxx.xxxx
9306 Farwest Dr SW
Lakewood, WA 98498
-----Original Message-----
From: George Oro [mailto:george@c...]
Sent: Wednesday, May 29, 2002 7:57 AM
To: Access
Subject: [access] Please Help: Validate Email Address before sending
Hi Guys,
Actually I have a table called tblMyContacts as the source if I'm
sending an
email via access. The problem I encountered is, if I want to send to all
my contacts using a loop, in between the process will stop
and I'm sure due to wrong email address. How can I
see which address is wrong and skip the error and continue till the end?
THIS IS NOT FOR SPAM MAIL!!!
Your help on the above matters is highly appreciated.
Cheers,
George
Message #3 by "George Oro" <george@c...> on Thu, 30 May 2002 09:38:45 +0400
|
|
John,
Thanks for the tips but I tried all my best but I can't figure it out.
Below is the code which I'm using, maybe it will give you more idea.
Please help John...
Cheers,
George
_______________________________________________________________________________________________
Public Sub HTMLFormat()
Dim wk As Workspace
Dim db As Database
Dim rs As Recordset
Set wk = DBEngine.Workspaces(0)
Set db = wk.OpenDatabase("C:\Database\MCS\Email\Contacts.mdb")
Set rs = db.OpenRecordset("tblContacts")
Do While Not rs.EOF
Dim strTo As String
Dim strSubject As String
Dim strBody As String
strTo = rs("EmailAddress")
strSubject = Me.txtSubject
strBody = Me.txtBody
Dim appOutlook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutLook = appOutlook.CreateItem(0)
MailOutLook.To = strTo
MailOutLook.Subject = strSubject
MailOutLook.HTMLBody = txtBody
MailOutLook.Send
rs.MoveNext
Me.ActiveXCtl30.Value = rs.PercentPosition
Loop
MsgBox "Message sent: " & rs.RecordCount & " Records.", vbInformation, "Send HTML Email"
End Sub
________________________________________________________________________________________________
-----Original Message-----
From: John Ruff [mailto:papparuff@c...]
Sent: Wednesday, May 29, 2002 7:23 PM
To: Access
Subject: [access] RE: Please Help: Validate Email Address before sending
Just before the .send in your code try add this:
' resolve each Recipient's name
For Each olookRecipient In .Recipients
olookRecipient.Resolve
If Not olookRecipient.Resolve Then
olookMsg.Display ' display any names that can't be
resolved
End If
Next
(The olookRecipient is Dim olookRecipient As Outlook.Recipient in this
sample)
You can also rem your On Error... statement to see where the code is
erring out.
John Ruff - The Eternal Optimist :-)
Always Looking for a Contract Opportunity
xxx.xxx.xxxx
9306 Farwest Dr SW
Lakewood, WA 98498
-----Original Message-----
From: George Oro [mailto:george@c...]
Sent: Wednesday, May 29, 2002 7:57 AM
To: Access
Subject: [access] Please Help: Validate Email Address before sending
Hi Guys,
Actually I have a table called tblMyContacts as the source if I'm
sending an
email via access. The problem I encountered is, if I want to send to all
my contacts using a loop, in between the process will stop
and I'm sure due to wrong email address. How can I
see which address is wrong and skip the error and continue till the end?
THIS IS NOT FOR SPAM MAIL!!!
Your help on the above matters is highly appreciated.
Cheers,
George
Message #4 by "John Ruff" <papparuff@c...> on Wed, 29 May 2002 23:30:09 -0700
|
|
1. I've modified your code so that it should work and I'm providing
another procedure that performs the same function. The difference? The
first procedure sends 1 email message for each email address. The
second procedure sends 1 email message to multiple recipients.
2. Cut and paste these procedures into a new Module (call it basEmail).
Call whichever procedure you prefer from your form, like this;
For procedure 1
SendHTMLFormatEmail txtSubject, txtBody, ActiveXCtl30
For procedure 2
SendHTMLFormatEmail_1 txtSubject, txtBody, ActiveXCtl30
'PROCEDURE 1
************************************************************
Option Compare Database
Option Explicit
Public Sub SendHTMLFormatEmail(strSubject As String, strBody As String,
_
ActiveXCtl30 As Control)
' This sends one email message per recipient
' (For example: 10 recipients, 10 email messages)
Dim wk As dao.Workspace
Dim db As dao.Database
Dim rs As dao.Recordset
Dim appOutlook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim RecipientOutlook As Outlook.Recipient
' Create the Outlook session
Set appOutlook = CreateObject("Outlook.Application")
' Create the message
Set MailOutLook = appOutlook.CreateItem(olMailItem)
Set wk = DBEngine.Workspaces(0)
Set db = wk.OpenDatabase("C:\Database\MCS\Email\Contacts.mdb")
Set rs = db.OpenRecordset("tblContacts")
Do While Not rs.EOF
With MailOutLook
' Add the To recipient to the message
Set RecipientOutlook = .Recipients.Add(rs!EmailAddress)
RecipientOutlook.Type = olTo
' Set the Subject and Body of the message
.Subject = strSubject
.HTMLBody = strBody
' Set the Importance of the message
.Importance = olImportanceNormal ' Normal importance
' .Importance = olImportanceHigh ' High importance
' .Importance = olImportanceLow ' Low importance
' Resolve each Recipient's name.
For Each RecipientOutlook In .Recipients
RecipientOutlook.Resolve
If Not RecipientOutlook.Resolve Then
' You can create an array to store the names of
those
' who could not be resolved or have a checkbox as
part
' of the recordset and set it to No if the recipient
' could not be resolved.
.Display ' Display any names that can't be
resolved.
End If
Next
.Send
End With
rs.MoveNext
ActiveXCtl30.Value = rs.PercentPosition
Loop
MsgBox "Message sent: " & rs.RecordCount & " Records.",
vbInformation, "Send HTML Email"
End Sub
'PROCEDURE 2
************************************************************
Public Sub SendHTMLFormatEmail_1(strSubject As String, strBody As
String, _
ActiveXCtl30 As Control)
' This sends one email message per recipient
' (For example: 10 recipients, 1 email message)
Dim wk As dao.Workspace
Dim db As dao.Database
Dim rs As dao.Recordset
Dim appOutlook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim RecipientOutlook As Outlook.Recipient
Dim strRecipient As String
Dim intCount As Integer
' Create the Outlook session
Set appOutlook = CreateObject("Outlook.Application")
' Create the message
Set MailOutLook = appOutlook.CreateItem(olMailItem)
Set wk = DBEngine.Workspaces(0)
Set db = wk.OpenDatabase("C:\Database\MCS\Email\Contacts.mdb")
Set rs = db.OpenRecordset("tblContacts")
' Determine how many email recipients there are
If Not rs.BOF Or Not rs.EOF Then
rs.MoveLast
intCount = rs.RecordCount
rs.MoveFirst
End If
' Fill the strRecipient variable with all the
' email addresses
Do While Not rs.EOF
strRecipient = strRecipient & ";" & rs!EmailAddress
rs.MoveNext
ActiveXCtl30.Value = rs.PercentPosition
Loop
' If the last character of the
' strRecipient string = ;
' then remove it
If Right(strRecipient, 1) = ";" Then
strRecipient = Left(strRecipient, Len(strRecipient) - 1)
End If
With MailOutLook
' Add the strRecipient variable to the message
Set RecipientOutlook = .Recipients.Add(strRecipient)
RecipientOutlook.Type = olTo
' Set the Subject and Body of the message
.Subject = strSubject
.HTMLBody = strBody
' Set the Importance of the message
.Importance = olImportanceNormal ' Normal importance
' .Importance = olImportanceHigh ' High importance
' .Importance = olImportanceLow ' Low importance
' Resolve each Recipient's name.
For Each RecipientOutlook In .Recipients
RecipientOutlook.Resolve
If Not RecipientOutlook.Resolve Then
' You can create an array to store the names of those
' who could not be resolved or have a checkbox as part
' of the recordset and set it to No if the recipient
' could not be resolved.
.Display ' Display any names that can't be resolved.
End If
Next
.Send
End With
MsgBox "Message sent to " & intCount & " Addresses.", vbInformation,
"Send HTML Email"
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
John Ruff - The Eternal Optimist :-)
Always Looking for a Contract Opportunity
xxx.xxx.xxxx
9306 Farwest Dr SW
Lakewood, WA 98498
-----Original Message-----
From: George Oro [mailto:george@c...]
Sent: Wednesday, May 29, 2002 10:39 PM
To: Access
Subject: [access] RE: Please Help: Validate Email Address before sending
John,
Thanks for the tips but I tried all my best but I can't figure it out.
Below is the code which I'm using, maybe it will give you more idea.
Please help John...
Cheers,
George
________________________________________________________________________
_______________________
Public Sub HTMLFormat()
Dim wk As Workspace
Dim db As Database
Dim rs As Recordset
Set wk = DBEngine.Workspaces(0)
Set db = wk.OpenDatabase("C:\Database\MCS\Email\Contacts.mdb")
Set rs = db.OpenRecordset("tblContacts")
Do While Not rs.EOF
Dim strTo As String
Dim strSubject As String
Dim strBody As String
strTo = rs("EmailAddress")
strSubject = Me.txtSubject
strBody = Me.txtBody
Dim appOutlook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutLook = appOutlook.CreateItem(0)
MailOutLook.To = strTo
MailOutLook.Subject = strSubject
MailOutLook.HTMLBody = txtBody
MailOutLook.Send
rs.MoveNext
Me.ActiveXCtl30.Value = rs.PercentPosition
Loop
MsgBox "Message sent: " & rs.RecordCount & " Records.",
vbInformation, "Send HTML Email"
End Sub
________________________________________________________________________
________________________
-----Original Message-----
From: John Ruff [mailto:papparuff@c...]
Sent: Wednesday, May 29, 2002 7:23 PM
To: Access
Subject: [access] RE: Please Help: Validate Email Address before sending
Just before the .send in your code try add this:
' resolve each Recipient's name
For Each olookRecipient In .Recipients
olookRecipient.Resolve
If Not olookRecipient.Resolve Then
olookMsg.Display ' display any names that can't be
resolved
End If
Next
(The olookRecipient is Dim olookRecipient As Outlook.Recipient in this
sample)
You can also rem your On Error... statement to see where the code is
erring out.
John Ruff - The Eternal Optimist :-)
Always Looking for a Contract Opportunity
xxx.xxx.xxxx
9306 Farwest Dr SW
Lakewood, WA 98498
-----Original Message-----
From: George Oro [mailto:george@c...]
Sent: Wednesday, May 29, 2002 7:57 AM
To: Access
Subject: [access] Please Help: Validate Email Address before sending
Hi Guys,
Actually I have a table called tblMyContacts as the source if I'm
sending an
email via access. The problem I encountered is, if I want to send to all
my contacts using a loop, in between the process will stop
and I'm sure due to wrong email address. How can I
see which address is wrong and skip the error and continue till the end?
THIS IS NOT FOR SPAM MAIL!!!
Your help on the above matters is highly appreciated.
Cheers,
George
Message #5 by "George Oro" <george@c...> on Thu, 30 May 2002 12:14:31 +0400
|
|
John,
Many, many thanks for your help but one more glitch, I forgot to tell you that this email should be PERSONALIZED. Means the receiver
should not seen the other Addresses, therefore they should received it like this:
From: George
To: John Ruff not like John Ruff; Jason Brown; etc...
Subject: Annual Meeting
bla,bla, bla...
because once they send reply, it will reply to all addresses in the To:
Actually I'm still doing my very best to figure it out, but still no luck.
Sorry John, hope for help...
Cheers,
George
-----Original Message-----
From: John Ruff [mailto:papparuff@c...]
Sent: Thursday, May 30, 2002 10:30 AM
To: Access
Subject: [access] RE: Please Help: Validate Email Address before sending
1. I've modified your code so that it should work and I'm providing
another procedure that performs the same function. The difference? The
first procedure sends 1 email message for each email address. The
second procedure sends 1 email message to multiple recipients.
2. Cut and paste these procedures into a new Module (call it basEmail).
Call whichever procedure you prefer from your form, like this;
For procedure 1
SendHTMLFormatEmail txtSubject, txtBody, ActiveXCtl30
For procedure 2
SendHTMLFormatEmail_1 txtSubject, txtBody, ActiveXCtl30
'PROCEDURE 1
************************************************************
Option Compare Database
Option Explicit
Public Sub SendHTMLFormatEmail(strSubject As String, strBody As String,
_
ActiveXCtl30 As Control)
' This sends one email message per recipient
' (For example: 10 recipients, 10 email messages)
Dim wk As dao.Workspace
Dim db As dao.Database
Dim rs As dao.Recordset
Dim appOutlook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim RecipientOutlook As Outlook.Recipient
' Create the Outlook session
Set appOutlook = CreateObject("Outlook.Application")
' Create the message
Set MailOutLook = appOutlook.CreateItem(olMailItem)
Set wk = DBEngine.Workspaces(0)
Set db = wk.OpenDatabase("C:\Database\MCS\Email\Contacts.mdb")
Set rs = db.OpenRecordset("tblContacts")
Do While Not rs.EOF
With MailOutLook
' Add the To recipient to the message
Set RecipientOutlook = .Recipients.Add(rs!EmailAddress)
RecipientOutlook.Type = olTo
' Set the Subject and Body of the message
.Subject = strSubject
.HTMLBody = strBody
' Set the Importance of the message
.Importance = olImportanceNormal ' Normal importance
' .Importance = olImportanceHigh ' High importance
' .Importance = olImportanceLow ' Low importance
' Resolve each Recipient's name.
For Each RecipientOutlook In .Recipients
RecipientOutlook.Resolve
If Not RecipientOutlook.Resolve Then
' You can create an array to store the names of
those
' who could not be resolved or have a checkbox as
part
' of the recordset and set it to No if the recipient
' could not be resolved.
.Display ' Display any names that can't be
resolved.
End If
Next
.Send
End With
rs.MoveNext
ActiveXCtl30.Value = rs.PercentPosition
Loop
MsgBox "Message sent: " & rs.RecordCount & " Records.",
vbInformation, "Send HTML Email"
End Sub
'PROCEDURE 2
************************************************************
Public Sub SendHTMLFormatEmail_1(strSubject As String, strBody As
String, _
ActiveXCtl30 As Control)
' This sends one email message per recipient
' (For example: 10 recipients, 1 email message)
Dim wk As dao.Workspace
Dim db As dao.Database
Dim rs As dao.Recordset
Dim appOutlook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim RecipientOutlook As Outlook.Recipient
Dim strRecipient As String
Dim intCount As Integer
' Create the Outlook session
Set appOutlook = CreateObject("Outlook.Application")
' Create the message
Set MailOutLook = appOutlook.CreateItem(olMailItem)
Set wk = DBEngine.Workspaces(0)
Set db = wk.OpenDatabase("C:\Database\MCS\Email\Contacts.mdb")
Set rs = db.OpenRecordset("tblContacts")
' Determine how many email recipients there are
If Not rs.BOF Or Not rs.EOF Then
rs.MoveLast
intCount = rs.RecordCount
rs.MoveFirst
End If
' Fill the strRecipient variable with all the
' email addresses
Do While Not rs.EOF
strRecipient = strRecipient & ";" & rs!EmailAddress
rs.MoveNext
ActiveXCtl30.Value = rs.PercentPosition
Loop
' If the last character of the
' strRecipient string = ;
' then remove it
If Right(strRecipient, 1) = ";" Then
strRecipient = Left(strRecipient, Len(strRecipient) - 1)
End If
With MailOutLook
' Add the strRecipient variable to the message
Set RecipientOutlook = .Recipients.Add(strRecipient)
RecipientOutlook.Type = olTo
' Set the Subject and Body of the message
.Subject = strSubject
.HTMLBody = strBody
' Set the Importance of the message
.Importance = olImportanceNormal ' Normal importance
' .Importance = olImportanceHigh ' High importance
' .Importance = olImportanceLow ' Low importance
' Resolve each Recipient's name.
For Each RecipientOutlook In .Recipients
RecipientOutlook.Resolve
If Not RecipientOutlook.Resolve Then
' You can create an array to store the names of those
' who could not be resolved or have a checkbox as part
' of the recordset and set it to No if the recipient
' could not be resolved.
.Display ' Display any names that can't be resolved.
End If
Next
.Send
End With
MsgBox "Message sent to " & intCount & " Addresses.", vbInformation,
"Send HTML Email"
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
John Ruff - The Eternal Optimist :-)
Always Looking for a Contract Opportunity
xxx.xxx.xxxx
9306 Farwest Dr SW
Lakewood, WA 98498
-----Original Message-----
From: George Oro [mailto:george@c...]
Sent: Wednesday, May 29, 2002 10:39 PM
To: Access
Subject: [access] RE: Please Help: Validate Email Address before sending
John,
Thanks for the tips but I tried all my best but I can't figure it out.
Below is the code which I'm using, maybe it will give you more idea.
Please help John...
Cheers,
George
________________________________________________________________________
_______________________
Public Sub HTMLFormat()
Dim wk As Workspace
Dim db As Database
Dim rs As Recordset
Set wk = DBEngine.Workspaces(0)
Set db = wk.OpenDatabase("C:\Database\MCS\Email\Contacts.mdb")
Set rs = db.OpenRecordset("tblContacts")
Do While Not rs.EOF
Dim strTo As String
Dim strSubject As String
Dim strBody As String
strTo = rs("EmailAddress")
strSubject = Me.txtSubject
strBody = Me.txtBody
Dim appOutlook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutLook = appOutlook.CreateItem(0)
MailOutLook.To = strTo
MailOutLook.Subject = strSubject
MailOutLook.HTMLBody = txtBody
MailOutLook.Send
rs.MoveNext
Me.ActiveXCtl30.Value = rs.PercentPosition
Loop
MsgBox "Message sent: " & rs.RecordCount & " Records.",
vbInformation, "Send HTML Email"
End Sub
________________________________________________________________________
________________________
-----Original Message-----
From: John Ruff [mailto:papparuff@c...]
Sent: Wednesday, May 29, 2002 7:23 PM
To: Access
Subject: [access] RE: Please Help: Validate Email Address before sending
Just before the .send in your code try add this:
' resolve each Recipient's name
For Each olookRecipient In .Recipients
olookRecipient.Resolve
If Not olookRecipient.Resolve Then
olookMsg.Display ' display any names that can't be
resolved
End If
Next
(The olookRecipient is Dim olookRecipient As Outlook.Recipient in this
sample)
You can also rem your On Error... statement to see where the code is
erring out.
John Ruff - The Eternal Optimist :-)
Always Looking for a Contract Opportunity
xxx.xxx.xxxx
9306 Farwest Dr SW
Lakewood, WA 98498
-----Original Message-----
From: George Oro [mailto:george@c...]
Sent: Wednesday, May 29, 2002 7:57 AM
To: Access
Subject: [access] Please Help: Validate Email Address before sending
Hi Guys,
Actually I have a table called tblMyContacts as the source if I'm
sending an
email via access. The problem I encountered is, if I want to send to all
my contacts using a loop, in between the process will stop
and I'm sure due to wrong email address. How can I
see which address is wrong and skip the error and continue till the end?
THIS IS NOT FOR SPAM MAIL!!!
Your help on the above matters is highly appreciated.
Cheers,
George
Message #6 by "John Ruff" <papparuff@c...> on Thu, 30 May 2002 05:46:03 -0700
|
|
Procedure 1 does exactly that. It will send one email to one addressee.
John Ruff - The Eternal Optimist :-)
Always Looking for a Contract Opportunity
xxx.xxx.xxxx
9306 Farwest Dr SW
Lakewood, WA 98498
-----Original Message-----
From: George Oro [mailto:george@c...]
Sent: Thursday, May 30, 2002 1:15 AM
To: Access
Subject: [access] RE: Please Help: Validate Email Address before sending
John,
Many, many thanks for your help but one more glitch, I forgot to tell
you that this email should be PERSONALIZED. Means the receiver
should not seen the other Addresses, therefore they should received it
like this:
From: George
To: John Ruff not like John Ruff; Jason Brown; etc...
Subject: Annual Meeting
bla,bla, bla...
because once they send reply, it will reply to all addresses in the To:
Actually I'm still doing my very best to figure it out, but still no
luck.
Sorry John, hope for help...
Cheers,
George
-----Original Message-----
From: John Ruff [mailto:papparuff@c...]
Sent: Thursday, May 30, 2002 10:30 AM
To: Access
Subject: [access] RE: Please Help: Validate Email Address before sending
1. I've modified your code so that it should work and I'm providing
another procedure that performs the same function. The difference? The
first procedure sends 1 email message for each email address. The
second procedure sends 1 email message to multiple recipients.
2. Cut and paste these procedures into a new Module (call it basEmail).
Call whichever procedure you prefer from your form, like this;
For procedure 1
SendHTMLFormatEmail txtSubject, txtBody, ActiveXCtl30
For procedure 2
SendHTMLFormatEmail_1 txtSubject, txtBody, ActiveXCtl30
'PROCEDURE 1
************************************************************
Option Compare Database
Option Explicit
Public Sub SendHTMLFormatEmail(strSubject As String, strBody As String,
_
ActiveXCtl30 As Control)
' This sends one email message per recipient
' (For example: 10 recipients, 10 email messages)
Dim wk As dao.Workspace
Dim db As dao.Database
Dim rs As dao.Recordset
Dim appOutlook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim RecipientOutlook As Outlook.Recipient
' Create the Outlook session
Set appOutlook = CreateObject("Outlook.Application")
' Create the message
Set MailOutLook = appOutlook.CreateItem(olMailItem)
Set wk = DBEngine.Workspaces(0)
Set db = wk.OpenDatabase("C:\Database\MCS\Email\Contacts.mdb")
Set rs = db.OpenRecordset("tblContacts")
Do While Not rs.EOF
With MailOutLook
' Add the To recipient to the message
Set RecipientOutlook = .Recipients.Add(rs!EmailAddress)
RecipientOutlook.Type = olTo
' Set the Subject and Body of the message
.Subject = strSubject
.HTMLBody = strBody
' Set the Importance of the message
.Importance = olImportanceNormal ' Normal importance
' .Importance = olImportanceHigh ' High importance
' .Importance = olImportanceLow ' Low importance
' Resolve each Recipient's name.
For Each RecipientOutlook In .Recipients
RecipientOutlook.Resolve
If Not RecipientOutlook.Resolve Then
' You can create an array to store the names of
those
' who could not be resolved or have a checkbox as
part
' of the recordset and set it to No if the recipient
' could not be resolved.
.Display ' Display any names that can't be
resolved.
End If
Next
.Send
End With
rs.MoveNext
ActiveXCtl30.Value = rs.PercentPosition
Loop
MsgBox "Message sent: " & rs.RecordCount & " Records.",
vbInformation, "Send HTML Email"
End Sub
'PROCEDURE 2
************************************************************
Public Sub SendHTMLFormatEmail_1(strSubject As String, strBody As
String, _
ActiveXCtl30 As Control)
' This sends one email message per recipient
' (For example: 10 recipients, 1 email message)
Dim wk As dao.Workspace
Dim db As dao.Database
Dim rs As dao.Recordset
Dim appOutlook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim RecipientOutlook As Outlook.Recipient
Dim strRecipient As String
Dim intCount As Integer
' Create the Outlook session
Set appOutlook = CreateObject("Outlook.Application")
' Create the message
Set MailOutLook = appOutlook.CreateItem(olMailItem)
Set wk = DBEngine.Workspaces(0)
Set db = wk.OpenDatabase("C:\Database\MCS\Email\Contacts.mdb")
Set rs = db.OpenRecordset("tblContacts")
' Determine how many email recipients there are
If Not rs.BOF Or Not rs.EOF Then
rs.MoveLast
intCount = rs.RecordCount
rs.MoveFirst
End If
' Fill the strRecipient variable with all the
' email addresses
Do While Not rs.EOF
strRecipient = strRecipient & ";" & rs!EmailAddress
rs.MoveNext
ActiveXCtl30.Value = rs.PercentPosition
Loop
' If the last character of the
' strRecipient string = ;
' then remove it
If Right(strRecipient, 1) = ";" Then
strRecipient = Left(strRecipient, Len(strRecipient) - 1)
End If
With MailOutLook
' Add the strRecipient variable to the message
Set RecipientOutlook = .Recipients.Add(strRecipient)
RecipientOutlook.Type = olTo
' Set the Subject and Body of the message
.Subject = strSubject
.HTMLBody = strBody
' Set the Importance of the message
.Importance = olImportanceNormal ' Normal importance
' .Importance = olImportanceHigh ' High importance
' .Importance = olImportanceLow ' Low importance
' Resolve each Recipient's name.
For Each RecipientOutlook In .Recipients
RecipientOutlook.Resolve
If Not RecipientOutlook.Resolve Then
' You can create an array to store the names of those
' who could not be resolved or have a checkbox as part
' of the recordset and set it to No if the recipient
' could not be resolved.
.Display ' Display any names that can't be resolved.
End If
Next
.Send
End With
MsgBox "Message sent to " & intCount & " Addresses.", vbInformation,
"Send HTML Email"
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
John Ruff - The Eternal Optimist :-)
Always Looking for a Contract Opportunity
xxx.xxx.xxxx
9306 Farwest Dr SW
Lakewood, WA 98498
-----Original Message-----
From: George Oro [mailto:george@c...]
Sent: Wednesday, May 29, 2002 10:39 PM
To: Access
Subject: [access] RE: Please Help: Validate Email Address before sending
John,
Thanks for the tips but I tried all my best but I can't figure it out.
Below is the code which I'm using, maybe it will give you more idea.
Please help John...
Cheers,
George
________________________________________________________________________
_______________________
Public Sub HTMLFormat()
Dim wk As Workspace
Dim db As Database
Dim rs As Recordset
Set wk = DBEngine.Workspaces(0)
Set db = wk.OpenDatabase("C:\Database\MCS\Email\Contacts.mdb")
Set rs = db.OpenRecordset("tblContacts")
Do While Not rs.EOF
Dim strTo As String
Dim strSubject As String
Dim strBody As String
strTo = rs("EmailAddress")
strSubject = Me.txtSubject
strBody = Me.txtBody
Dim appOutlook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutLook = appOutlook.CreateItem(0)
MailOutLook.To = strTo
MailOutLook.Subject = strSubject
MailOutLook.HTMLBody = txtBody
MailOutLook.Send
rs.MoveNext
Me.ActiveXCtl30.Value = rs.PercentPosition
Loop
MsgBox "Message sent: " & rs.RecordCount & " Records.",
vbInformation, "Send HTML Email"
End Sub
________________________________________________________________________
________________________
-----Original Message-----
From: John Ruff [mailto:papparuff@c...]
Sent: Wednesday, May 29, 2002 7:23 PM
To: Access
Subject: [access] RE: Please Help: Validate Email Address before sending
Just before the .send in your code try add this:
' resolve each Recipient's name
For Each olookRecipient In .Recipients
olookRecipient.Resolve
If Not olookRecipient.Resolve Then
olookMsg.Display ' display any names that can't be
resolved
End If
Next
(The olookRecipient is Dim olookRecipient As Outlook.Recipient in this
sample)
You can also rem your On Error... statement to see where the code is
erring out.
John Ruff - The Eternal Optimist :-)
Always Looking for a Contract Opportunity
xxx.xxx.xxxx
9306 Farwest Dr SW
Lakewood, WA 98498
-----Original Message-----
From: George Oro [mailto:george@c...]
Sent: Wednesday, May 29, 2002 7:57 AM
To: Access
Subject: [access] Please Help: Validate Email Address before sending
Hi Guys,
Actually I have a table called tblMyContacts as the source if I'm
sending an
email via access. The problem I encountered is, if I want to send to all
my contacts using a loop, in between the process will stop
and I'm sure due to wrong email address. How can I
see which address is wrong and skip the error and continue till the end?
THIS IS NOT FOR SPAM MAIL!!!
Your help on the above matters is highly appreciated.
Cheers,
George
|
|
|
View Cart
