Results 1 to 5 of 5
  1. #1
    Join Date
    Mar 2004
    Location
    New Hampshire Coast
    Posts
    18

    Exclamation Unanswered: Emailing reports Outlook Security problem

    Hi all,
    I'm new to the forum and I've searched around, but haven't found quite the answer I need. I'm attempting to automate a database to email some reports off-hours. I'm using the standard scheduler with Windows. I've written some code to execute when the database opens and it gets most of the way through, but I get hung up on the Outlook E-Mail Security Update.....which comes up with a prompt saying "A Program is trying to access e-mail......." you know the rest I'm sure.

    I found some code on the microsoft website, but I don't think it's quite right. Can someone help?? Thanks. I've got the error code commented out 'cause it didn't work.

    Private Sub Form_Load()

    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.

    Set objOutlookRecip = .Recipients.Add("Myles England")
    objOutlookRecip.Type = olTo

    ' Add the CC recipient(s) to the message.
    'Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
    'objOutlookRecip.Type = olCC

    ' Set the Subject, Body, and Importance of the message.
    .Subject = "Daily Balancing Report" & Date
    .Body = vbCrLf & vbCrLf
    '.Importance = olNormal 'Normal importance

    ' Add attachments to the message.
    If Not IsMissing(AttachmentPath) Then
    Set objOutlookAttach = .Attachments.Add("\\path\DailyBalancingReport.xls" )
    End If

    ' Resolve each Recipient's name.
    For Each objOutlookRecip In .Recipients
    objOutlookRecip.Resolve
    If Not objOutlookRecip.Resolve Then
    objOutlookMsg.Display
    End If
    Next
    objOutlookMsg.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/prev.../security.asp."
    'Else
    'MsgBox Err.Number, Err.Description
    'End If

    End Sub

  2. #2
    Join Date
    Jan 2004
    Location
    Toronto, Canada
    Posts
    259
    ah, the tell tale microsoft security update; you can get past this by using a specific module called the "Outlook Redemption" module

    http://www.dimastr.com/redemption/

    this module emulates outlook and emails the message without having that annoying message come up; just install it, and then once done, in Tools->References, make sure you add "SafeOutlook" as one of them

    then add this codee...

    Dim safeitem, oItem As Object
    Set safeitem = CreateObject("Redemption.SafeMailItem")
    Set oItem = Application.CreateItem(0)
    safeitem.Recipients.Add "somebody@microsoft.com"
    safeitem.Recipients.ResolveAll
    safeitem.Subject = "yee"
    safeitem.RTFBody = "get past this limitation!"
    safeitem.Send


    if you want more features...look at their website!

  3. #3
    Join Date
    Mar 2004
    Location
    New Hampshire Coast
    Posts
    18
    Hi Jerrie,
    Thanks for the tip. One catch, I am doing this in a commercial environment, one which doesn't allow me to download or install anything! Any suggestions on how to get the MS code to work?
    Thanks


    Originally posted by Jerrie
    ah, the tell tale microsoft security update; you can get past this by using a specific module called the "Outlook Redemption" module

    http://www.dimastr.com/redemption/

    this module emulates outlook and emails the message without having that annoying message come up; just install it, and then once done, in Tools->References, make sure you add "SafeOutlook" as one of them

    then add this codee...

    Dim safeitem, oItem As Object
    Set safeitem = CreateObject("Redemption.SafeMailItem")
    Set oItem = Application.CreateItem(0)
    safeitem.Recipients.Add "somebody@microsoft.com"
    safeitem.Recipients.ResolveAll
    safeitem.Subject = "yee"
    safeitem.RTFBody = "get past this limitation!"
    safeitem.Send


    if you want more features...look at their website!

  4. #4
    Join Date
    Jan 2004
    Location
    Toronto, Canada
    Posts
    259
    you could try doing a sendkeys, to try to click that enter button for you;
    however, sendkeys is not a good alternative since it doesn't work sometimes;

    here's another method which is more reliable;
    just dl the zip i have here. it has a module, and a class file;
    then include them in your db.

    Dim cSK As New cSendKeys
    cSK.KeyDown MoreKeyConstants.VK_LWIN
    cSK.KeyUp MoreKeyConstants.VK_LWIN

    cSK.KeyUp vbKeyUp
    csk.KeyDown vbkeyUp

    you can use either morekeyconstants, or just the plain csk.KeyUp ....
    note however, that you must have a keyup and keydown combo if ur gonna use them.

    also, use the sleep api call.
    Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

    experiment with it till you get the right combo...e.g

    after you do the outlook thing...

    sleep 10000
    csk.KeyUp vbKeyReturn 'press enter on that damn pop up
    csk.keyDown vbKeyReturn

  5. #5
    Join Date
    Jan 2004
    Location
    Toronto, Canada
    Posts
    259
    forgot to attach!
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •