Hi all, i've just downloaded redemption and set a reference to it, but am unsure how to adapt my code so that it makes use of it and by-passes the access/outlook email warning.
If any one could have a pop at modifying my code so that it makes use of redemption that would be greatly appreciated.
Thanks in advance
Send Button - On Click Code:
Private Sub SendButton_Click()
'Send Email when user clicks on button
'Make a connection to the db
Dim myConnection As ADODB.Connection
Set myConnection = CurrentProject.Connection
Dim myRecordSet As New ADODB.Recordset
myRecordSet.ActiveConnection = myConnection
'Define variables for outlook application
Dim appOutlook As Outlook.Application 'Refers to Outlook's Application object.
Dim appOutlookMsg As Outlook.MailItem 'Refers to an Outlook e-mail message.
Dim appOutlookRecip As Outlook.Recipient 'Refers to an Outlook e-mail recipient.
'More general variables.
Dim mySQL As String, eMailAddress As String, whereClause As String
Dim countEm As Integer, myMsg As String
countEm = 0 'keep track of the number of messages sent.
'Start building the SQL statement for the recordset.
mySQL = "SELECT * FROM CustomerTBL"
'Create search condition based on selected option button.
'SendOptions.Value refers to the option button selected near bottom of form.
Select Case SendOptions.Value
Case 1 'All Customers
whereClause = " WHERE CustomerEmail Is Not Null"
Case 2 'Single customer from combo box
whereClause = " WHERE CustomerID= " & LookForID.Column(0)
End Select
'Finish the SQL statement.
mySQL = mySQL & whereClause
'Now let's open up the recordset and start going through, record-by-record.
myRecordSet.Open mySQL, , adOpenStatic, adLockOptimistic
'Bail out if recordset gets no records.
If myRecordSet.RecordCount < 1 Then
MsgBox ("There Are No Records That Meet The Criterion. No Messages Have Benn Sent.")
Exit Sub
End If
myRecordSet.MoveFirst
'Create an Outlook session in the background.
Set appOutlook = CreateObject("Outlook.Application")
'Now Set objSafeMail instead NEW CODE none taken out here reminder
Set objSafeMail = New Redemption.SafeMailItem
Do Until myRecordSet.EOF 'For each record in myRecordset...
'Get the e-mail address from current record of myRecordset.
eMailAddress = myRecordSet.Fields("CustomerEmail")
'If there's a # character in the eMail address...
If InStr(1, eMailAddress, "#") > 0 Then
'...then chop off the # and everything that follows it.
eMailAddress = Left(eMailAddress, InStr(1, eMailAddress, "#") - 1)
End If
'Create a new, empty e-mail message.
Set appOutlookMsg = appOutlook.CreateItem(olMailItem)
With appOutlookMsg 'Using the new, empty message...
' Address the new message.
Set appOutlookRecip = .Recipients.Add(eMailAddress)
appOutlookRecip.Type = olTo 'Sets message to normal outgoing e-mail message.
' Fill in the Subject line and main body of message.
.Subject = Me![Subject] 'Fill in the subject line.
.Body = Me![MessageBody] 'Fill in the message body.
'Add attachments, if any, to the e-mail message.
If Len(Me![Attachment]) > 0 Then
.Attachments.Add (Me![Attachment])
End If
.Send 'Send the completed message.
End With
myRecordSet.MoveNext 'Next record in recordset
countEm = countEm + 1 'Keeps track of number of messages printed for later display.
Loop 'Repeat with next record, if not eof.
myRecordSet.Close 'All records processed when loop done. Close recordset.
'Display feedback message.
myMsg = countEm & " Message(s) Sent To Outlook's Outbox"
myOKBox (myMsg)
'All done when loop done. Clean up and say bye-bye.
Set myRecordSet = Nothing
Set appOutlookMsg = Nothing
Set appOutlook = Nothing
Set myConnection = Nothing
End Sub
If any one could have a pop at modifying my code so that it makes use of redemption that would be greatly appreciated.
Thanks in advance
Send Button - On Click Code:
Private Sub SendButton_Click()
'Send Email when user clicks on button
'Make a connection to the db
Dim myConnection As ADODB.Connection
Set myConnection = CurrentProject.Connection
Dim myRecordSet As New ADODB.Recordset
myRecordSet.ActiveConnection = myConnection
'Define variables for outlook application
Dim appOutlook As Outlook.Application 'Refers to Outlook's Application object.
Dim appOutlookMsg As Outlook.MailItem 'Refers to an Outlook e-mail message.
Dim appOutlookRecip As Outlook.Recipient 'Refers to an Outlook e-mail recipient.
'More general variables.
Dim mySQL As String, eMailAddress As String, whereClause As String
Dim countEm As Integer, myMsg As String
countEm = 0 'keep track of the number of messages sent.
'Start building the SQL statement for the recordset.
mySQL = "SELECT * FROM CustomerTBL"
'Create search condition based on selected option button.
'SendOptions.Value refers to the option button selected near bottom of form.
Select Case SendOptions.Value
Case 1 'All Customers
whereClause = " WHERE CustomerEmail Is Not Null"
Case 2 'Single customer from combo box
whereClause = " WHERE CustomerID= " & LookForID.Column(0)
End Select
'Finish the SQL statement.
mySQL = mySQL & whereClause
'Now let's open up the recordset and start going through, record-by-record.
myRecordSet.Open mySQL, , adOpenStatic, adLockOptimistic
'Bail out if recordset gets no records.
If myRecordSet.RecordCount < 1 Then
MsgBox ("There Are No Records That Meet The Criterion. No Messages Have Benn Sent.")
Exit Sub
End If
myRecordSet.MoveFirst
'Create an Outlook session in the background.
Set appOutlook = CreateObject("Outlook.Application")
'Now Set objSafeMail instead NEW CODE none taken out here reminder
Set objSafeMail = New Redemption.SafeMailItem
Do Until myRecordSet.EOF 'For each record in myRecordset...
'Get the e-mail address from current record of myRecordset.
eMailAddress = myRecordSet.Fields("CustomerEmail")
'If there's a # character in the eMail address...
If InStr(1, eMailAddress, "#") > 0 Then
'...then chop off the # and everything that follows it.
eMailAddress = Left(eMailAddress, InStr(1, eMailAddress, "#") - 1)
End If
'Create a new, empty e-mail message.
Set appOutlookMsg = appOutlook.CreateItem(olMailItem)
With appOutlookMsg 'Using the new, empty message...
' Address the new message.
Set appOutlookRecip = .Recipients.Add(eMailAddress)
appOutlookRecip.Type = olTo 'Sets message to normal outgoing e-mail message.
' Fill in the Subject line and main body of message.
.Subject = Me![Subject] 'Fill in the subject line.
.Body = Me![MessageBody] 'Fill in the message body.
'Add attachments, if any, to the e-mail message.
If Len(Me![Attachment]) > 0 Then
.Attachments.Add (Me![Attachment])
End If
.Send 'Send the completed message.
End With
myRecordSet.MoveNext 'Next record in recordset
countEm = countEm + 1 'Keeps track of number of messages printed for later display.
Loop 'Repeat with next record, if not eof.
myRecordSet.Close 'All records processed when loop done. Close recordset.
'Display feedback message.
myMsg = countEm & " Message(s) Sent To Outlook's Outbox"
myOKBox (myMsg)
'All done when loop done. Clean up and say bye-bye.
Set myRecordSet = Nothing
Set appOutlookMsg = Nothing
Set appOutlook = Nothing
Set myConnection = Nothing
End Sub
