Accessing Personal Folders

[Andibevan]

Hi All,

I have been trying to use the Redemption add-in for outlook in order to
obtain information from e-mails without showing the security warnings. I
have created the code below that uses the GETFOLDER function taken from
outlookcode.com in order to access personal folders (also below). The
problem is that it still shows the security box - I think I need to replace
Set objFolder = GetFolder("Personal Folders/Forwarded Mail") with something
that doesn't use the outlook object model.

Any ideas?

Sub Redemption_Cycle_Through_and_Change_Contents_Of_Personal_Folder()
Dim CNT As Integer
Dim objFolder 'As Outlook.MAPIFolder
Dim Session

Set Session = CreateObject("Redemption.RDOSession")
Set objFolder = GetFolder("Personal Folders/Forwarded Mail")
Dim MSG
Dim Result As String

CNT = 1

For Each MSG In objFolder.Items
MsgBox MSG.SenderName
Next
MsgBox ("Completed!")
End Sub

'http://www.outlookcode.com/d/code/getfolder.htm
Public Function GetFolder(strFolderPath As String) As MAPIFolder
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim I As Long
On Error Resume Next

strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If

Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function

 

[Ken Slovak - [MVP - Outlook]]

Without modifying Sue's GetFolder routine you can just get the MAPIFolder
object as you do now and then use its EntryID and StoreID to get an
RDOFolder object.

Sub Redemption_Cycle_Through_and_Change_Contents_Of_Personal_Folder()
Dim CNT As Integer
Dim objFolder 'As Outlook.MAPIFolder
Dim safFolder 'As Redemption.RDOFolder
Dim Session

Set Session = CreateObject("Redemption.RDOSession")
Set objFolder = GetFolder("Personal Folders/Forwarded Mail")

Set safFolder =Session.GetFolderFromID(objFolder.EntryID,
objFolder.StoreID)

Dim MSG 'As Redemption.RDOMail

Dim Result As String

CNT = 1

For Each MSG In safFolder.Items
MsgBox MSG.SenderName
Next
MsgBox ("Completed!")
End Sub

 

[Andibevan]

Thanks for the suggestion Ken but when I try your code I get the error "not
logged on. Please Log on first" on the line Set safFolder = ........

 

[Andibevan]

Adding Session.logon sorted it - thanks

Thanks for the suggestion Ken but when I try your code I get the error "not
logged on. Please Log on first" on the line Set safFolder = ........