pauldonson
asked on
Using Outlook Redemption with MAPI pickfolder
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("M API")
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.
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("M
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Glad to help :)
ASKER
Problem sorted.