Access 2007 and automated emails...Redemption.dll?

[beachldy]

In Access 2003, I could test the emails and either get an error message or the email went through. In Access 2007 and Outlook 2007, I get no error message and the email appears to have gone through. Here is the code:

-------------------------------
Function SendEmailNotice(EmailTo As String, EmailSubject As String, Msg As String, Student As String, School As String)
'This works with redemption.dll
'1) register redemption.dll (regsvr32)
'2) Add reference redemption.dll
'3) Also requires reference to Microsoft Outlook Object Library

'Debug.Print Msg

Dim SafeItem, oItem
'Set oItem = Application.CreateItem(0) 'Create a new message
Set objOL = New Outlook.Application
Set oItem = objOL.CreateItem(olMailItem)
Set SafeItem = CreateObject("Redemption.SafeMailItem") 'Create an instance of Redemption.SafeMailItem
SafeItem.Item = oItem 'set Item property

SafeItem.Recipients.add EmailTo
SafeItem.Recipients.ResolveAll

'SafeItem.from = "whoever@hotmail.com" --From is no longer used with latest version of Redemption
'SafeItem.SenderName = "Test" --Cannot change sender info

SafeItem.Subject = EmailSubject
SafeItem.Body = Msg
'SafeItem.Attachments.Add "C:\Temp\attachment.txt"

SafeItem.Send


End Function

 

[G37Sam]

Does it not show any dialog boxes or warnings in outlook?

 

[ghudson]

When using code [and not the send object method!] , Outlook 2007 allows Access 2007 to send emails without prompting the user with the annoying prompt forcing the user to click the allow button to send the email.

 

[beachldy]

No error messages, nothing. The emails go through on an XP and Office 2003 machine, but not Windows 7 and Office 2007. Ghudson, what kind of code are you using? I have tried regular outlook coding but the warning message always comes up, that Outlook is trying to send an automated email, etc....so it requires the user's input to get past that. Could you send me an example of working code for sending an email? And what version Outlook library are you using? I have to put this app in both Access 2003 and Access 2007 versions.

 

[ghudson]

The below code is what I use to send emails without Outlook 2007 nagging the user with the allow email prompt. Office 2003 users will still get the allow email prompt. Outlook library versions and setting references do not matter with this code.

Sub SendEmail()
On Error GoTo Err_SendEmail

    Dim sTo As String
    Dim sCC As String
    Dim sSubject As String
    Dim sBody As String
    Dim sAttachmentList As String
    Dim sReplyRecipient As String
    
    Dim sPathFile As String
    sPathFile = "\\Server\Partition\Testing.xls"
    
    'You must key a semicolon between each email name.
    sTo = "johndoe@widgets.com; marysmith@widgets.com"
    sCC = "me@widgets.com"
    sReplyRecipient = "joecleck@widgets.com"
    sSubject = "Important Email"
    sBody = sBody & "Please read then destroy this important email!"
    sAttachmentList = sPathFile
    
    'send email with a file attachment
    'Call SetupOutlookEmail(sTo, sCC, sReplyRecipient, sSubject, sBody, sAttachmentList)
    
    'send email without a file attachment
    Call SetupOutlookEmail(sTo, sCC, sReplyRecipient, sSubject, sBody)

Exit_SendEmail:
    Exit Sub

Err_SendEmail:
    If Err.Number = -2147024894 Then 'Cannot find this file.  Verify the path and file name are correct.
        MsgBox "Email message was not sent.  Please verify the file exists @ " & sPathFile & " before attempting to resend the email.", vbCritical, "Invalid File Attachment"
        Exit Sub
    ElseIf Err.Number = -2147467259 Then 'Outlook does not recognize one or more names.
        MsgBox "Email message was not sent.  Please verify all user names and email addresses are valid before attempting to resend the email.", vbCritical, "Invalid Email Name"
        Exit Sub
    Else
        MsgBox Err.Number & " - " & Err.Description, vbCritical, "SendEmail()"
        Resume Exit_SendEmail
    End If
    
End Sub

Public Function SetupOutlookEmail(ByVal sTo As String, ByVal sCC As String, ByVal sReplyRecipient As String, ByVal sSubject As String, ByVal sBody As String, ParamArray sAttachmentList() As Variant) As Boolean
On Error GoTo Err_SetupOutlookEmail
    
    Dim objOLApp As Object
    Dim outItem As Object
    Dim outFolder As Object
    Dim DestFolder As Object
    Dim outNameSpace As Object
    Dim lngAttachment As Long

    Set objOLApp = CreateObject("Outlook.Application")
    Set outNameSpace = objOLApp.GetNamespace("MAPI")
    Set outFolder = outNameSpace.GetDefaultFolder(6)
    Set outItem = objOLApp.CreateItem(0)

    outItem.To = sTo
    outItem.CC = sCC
    outItem.Subject = sSubject
    outItem.HTMLBody = sBody
    outItem.ReplyRecipients.Add sReplyRecipient
    outItem.ReadReceiptRequested = False

    With outItem.Attachments
        For lngAttachment = LBound(sAttachmentList) To UBound(sAttachmentList)
            .Add sAttachmentList(lngAttachment)
        Next lngAttachment
    End With

    outItem.Send
    'outItem.Display 'setup and open email in edit mode instead of sending the email
    SetupOutlookEmail = True

Exit_SetupOutlookEmail:
    On Error Resume Next
    Set outItem = Nothing
    Set outFolder = Nothing
    Set outNameSpace = Nothing
    Set objOLApp = Nothing
    Exit Function

Err_SetupOutlookEmail:
    If Err.Number = 287 Then 'User stopped Outlook from sending email.
        MsgBox "User aborted email.", vbInformation, "Email Cancelled"
        Resume Exit_SetupOutlookEmail
    Else
        MsgBox Err.Number & " - " & Err.Description, vbCritical, "SetupOutlookEmail()"
        Resume Exit_SetupOutlookEmail
    End If

End Function