Solved

Navigating hiarchy of subfolders using Exchange / Outlook 2K / Redemption / CDO

Posted on 2010-08-25
6
822 Views
Last Modified: 2012-05-10
This code creates a subfolder under supportmail's inbox then moves a message from the inbox into it.
What if I needed to create additional subfolders under /inbox/select_company?

And last...is it possible from VBA to open an outlook folder as an explorer window, similar to right clicking on an email folder in outlook and selecting "open in new window"?

Set Session = CreateObject("Redemption.RDOSession")
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Session.Logon
Set Store = Session.Stores.GetSharedMailbox("supportmai") ' Set support mailbox
Set Inbox = Store.GetDefaultFolder(olFolderInbox) ' Set inbox as default
desthold = Me.Select_Company
 Set destfold = Inbox.Folders.Add(desthold)

' move message
Set rMessage = Session.GetMessageFromID(Me.EntryID)
rMessage.Move (destfold)

0
Comment
Question by:mattinvt
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
6 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 33525073
Hi, mattinvt.

I haven't used Redemption to manage folders before. Redemption is typically only needed to bypass Outlook's security constraints when accessing address fields and sending messages.  Assuming that the support mailbox is open (i.e. appears in the list of folders in the navigation pane), then the following code will get a folder and add a subfolder to it. The code also shows how to open a folder in a new window.  This is pure Outlook object model.
Dim olkSupportMbox As Outlook.MAPIFolder, _
    olkSubFolder1 As Outlook.MAPIFolder, _
    olkSubFolder2 As Outlook.MAPIFolder, _
    olkExplorer As Outlook.Explorer
Set olkSupportMbox = OpenOutlookFolder("supportmai\inbox")
desthold = Me.Select_Company
Set olkSubFolder1 = olkSupportMbox.Folders.Add(desthold)
'Add a folder under this subfolder'
Set olkSubFolder2 = olkSubFolder1.Folders.Add("Some Name")
'Display a folder in a new window'
Set olkExplorer = Application.Explorers.Add(olkSubFolder1)

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    ' Purpose: Opens an Outlook folder from a folder path.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        bolBeyondRoot As Boolean
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function

Open in new window

0
 

Author Comment

by:mattinvt
ID: 33538341
Set myOlApp = CreateObject("Outlook.Application")
Dim olkSupportMbox As Outlook.MAPIFolder, _
olkSubFolder1 As Outlook.MAPIFolder, _
olkSubFolder2 As Outlook.MAPIFolder, _
olkExplorer As Outlook.Explorer
Set olkSupportMbox = OpenOutlookFolder("supportmail\Inbox")
desthold = Me.COMPANY
Set olkSubFolder1 = olkSupportMbox.Folders.Add(desthold)

At Set olkSubFolder1 = olkSupportMbox.Folders.Add(desthold) I get a
"Runtime error 91
object variable or with block variable not set"

desthold=Test Company

AND
Set olkExplorer = Application.Explorers.Add(olkSubFolder1)
Highlights Explores and reports
"Method or Data Member not found"

Am I missing some References perhaps?

Note - This is currently on Outlook 2003 / Access 2000 but I'd like  it Outlook  2000 compatible even if I have to scrap 2003 support.

Thanks!



0
 
LVL 76

Accepted Solution

by:
David Lee earned 250 total points
ID: 33542298
The path "supportmail\Inbox" must not be valid.  Is "supportmail" the way the folder name appears in the navigation pane?
0
Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

 

Author Comment

by:mattinvt
ID: 33735100
This is the function that I developed with everyone's help.
It moves a message from either the INBOX or SENT ITEMS to another folder.
If from the inbox, it finds the ENTRYID passed
If from the outbox, it gets the last message.

Function MoveMail(WhatBox As String, InComp As String, Intype As String, InSub As String, InEntry As String) As String

Dim rSession As Redemption.rdoSession
Dim spt_store As RDOStore
Dim usr_store As RDOStore
Dim spt_inbox As RDOFolder
Dim usr_sent As RDOFolder
Dim Supportbox As Outlook.MAPIFolder, _
CreateCompany As Outlook.MAPIFolder, _
CreateType As Outlook.MAPIFolder

Dim items As RDOItems
Dim ITEM As RDOMail

Set rSession = CreateObject("Redemption.RDOSession")
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
rSession.Logon

' Create folders as needed

' Add company
Set Supportbox = OpenOutlookFolder("Mailbox - support\Customer_Email")
On Error Resume Next
Set CreateCompany = Supportbox.Folders.Add(InComp)
Set Supportbox = OpenOutlookFolder("Mailbox - support\Customer_Email\" & InComp)
Set CreateType = Supportbox.Folders.Add(Intype)
On Error GoTo 0

' Inbox
If WhatBox = "inbox" Then
    Set spt_store = rSession.Stores.GetSharedMailbox("support@somecompany.org") ' Set support mailbox
    Set rbox = spt_store.GetDefaultFolder(olFolderInbox) ' Set inbox as default
    Set rmessage = rSession.GetMessageFromID(InEntry)
    If Intype = "root" Then
        Set spt_path = spt_store.IPMRootFolder.Folders.ITEM("Customer_Email").Folders.ITEM(InComp)
    Else
        Set spt_path = spt_store.IPMRootFolder.Folders.ITEM("Customer_Email").Folders.ITEM(InComp).Folders.ITEM(Intype)
    End If
    rmessage.Move (spt_path)
End If

' Sent Items
If WhatBox = "sent" Then
    Set usr_store = rSession.Stores.DefaultStore ' set employee mailbox
    Set spt_store = rSession.Stores.GetSharedMailbox("support@somecompany.org") ' Set support mailbox
    Set usr_sent = usr_store.GetDefaultFolder(olFolderSentMail)  ' Set sent items as default
    Set items = usr_sent.items
    items.MAPITable.Sort "ReceivedTime", False
   
    For Each ITEM In items
        Z = ITEM.EntryID
    Next
    Set rmessage = rSession.GetMessageFromID(Z)
    If Not IsNull(Intype) Then
        Set spt_path = spt_store.IPMRootFolder.Folders.ITEM("Customer_Email").Folders.ITEM(InComp).Folders.ITEM(Intype)
    Else
        Set spt_path = spt_store.IPMRootFolder.Folders.ITEM("Customer_Email").Folders.ITEM(InComp)
    End If
    rmessage.Move (spt_path)
   
End If

rSession.Logoff

End Function

0
 

Author Closing Comment

by:mattinvt
ID: 33735108
Thanks!

See the function that came out of this.

0
 
LVL 76

Expert Comment

by:David Lee
ID: 33735162
You're welcome!
0

Featured Post

Has Powershell sent you back into the Stone Age?

If managing Active Directory using Windows Powershell® is making you feel like you stepped back in time, you are not alone.  For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Large Outlook files lead to various unwanted errors and corruption issues. Furthermore, large outlook files can also make Outlook take longer to start-up, search, navigate, and shut-down. So, In this article, i will discuss a method to make your Out…
A list of top three free exchange EDB viewers that helps the user to extract a mailbox from an unmounted .edb file and get a clear preview of all emails & other items with just a single click on mailboxes.
This video demonstrates how to sync Microsoft Exchange Public Folders with smartphones using CodeTwo Exchange Sync and Exchange ActiveSync. To learn more about CodeTwo Exchange Sync and download the free trial, go to: http://www.codetwo.com/excha…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an antispam), the admini…

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question