Solved

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

Posted on 2010-08-25
6
814 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
  • 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
Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

 

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

Problems using Powershell and Active Directory?

Managing Active Directory does not always have to be complicated.  If you are spending more time trying instead of doing, then it's time to look at something else. 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

Follow this checklist to learn more about the 15 things you should never include in an email signature from personal quotes, animated gifs and out-of-date marketing content.
Learn to move / copy / export exchange contacts to iPhone without using any software. Also see the issues in configuration of exchange with iPhone to migrate contacts.
To show how to generate a certificate request in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.:  First we need to log into the Exchange Admin Center. Navigate to the Servers >> Certificates…
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…

861 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

Need Help in Real-Time?

Connect with top rated Experts

30 Experts available now in Live!

Get 1:1 Help Now