troubleshooting Question

Using Outlook Redemption with MAPI pickfolder

Avatar of pauldonson
pauldonson asked on
Microsoft Access
3 Comments1 Solution1909 ViewsLast Modified:
Hi, I have a routine in my application that presents a list of Outlook folders to the user, they then select one and the routine goes through each email in that folder and processes it.

It works fine but I get the Outlook security warning when it starts accessing emails, I have Redemption 4.4 installed but aren't sure which part of the code is causing the security error (it allows the user to pick the folder before it produces the warning and it happens after the msgbox states that x items will be scanned.)

The code is quite long so I have just included the relevant bits: (Please note that I have to use late binding at all times due to different versions).

Dim appOutlook As Object, nms As Object, fld As Object, lngItemCount As Long, itm As Object
Dim msg As Object

Set appOutlook = GetObject(, "Outlook.Application")
Set nms = appOutlook.GetNamespace("MAPI")
Set fld = nms.PickFolder
If fld Is Nothing Then
    MsgBox "Nothing selected", vbExclamation, "Alert"
    Exit Sub
End If

If fld.DefaultItemType <> 0 Then '0 is the constant olMailItem
    MsgBox "Please select a mail folder.", vbExclamation, "Alert"
    Exit Sub
End If

lngItemCount = fld.Items.Count

If lngItemCount = 0 Then
    MsgBox "There are no items in the selected folder.", vbInformation, "Alert"
    Exit Sub
End If

If MsgBox(Format(lngItemCount) & " items will be scanned, continue?", vbQuestion & vbYesNo, "Alert") = vbNo Then Exit Sub

Screen.MousePointer = 11

Me.txtResults = ""
Me.txtResults.Requery
Me.Repaint

'Process the items
Dim cmd As ADODB.Command
Dim stm As ADODB.Stream
Dim att As Object, strfilename As String

Dim CV As String
Dim objWord As Object, objDoc As Object  'late binding
Dim tmpPersonID As Long, tmpPersonName As String, retcode As Long, tmpPersonFirst As String
Dim strResults As String

strResults = ""
strfilename = Environ("Temp") & "\BulkCVImport.doc"

For Each itm In fld.Items
    If itm.Class = 43 Then '43 is the constant olMail
        Set msg = itm 'I THINK THIS IS THE LINE CAUSING THE SECURITY WARNING
        If msg.SenderName = strSenderName Or msg.SenderName = strSenderName2 And msg.Attachments.Count > 0 Then
            For Each att In msg.Attachments
                att.SaveAsFile strfilename
           
                Set stm = New ADODB.Stream
                With stm
                    .Type = adTypeBinary
                    .Open
                    .LoadFromFile strfilename
                End With
            Next att
...Rest of code

Next Itm

I have to confess I am a bit out of my depth on this one so be gentle with me!

Thanks.
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 3 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 3 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros