?
Solved

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

Posted on 2010-08-25
6
Medium Priority
?
827 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 1000 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
Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

 

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

Veeam Task Manager for Hyper-V

Task Manager for Hyper-V provides critical information that allows you to monitor Hyper-V performance by displaying real-time views of CPU and memory at the individual VM-level, so you can quickly identify which VMs are using host resources.

Question has a verified solution.

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

How to resolve IMCEAEX NDRs in Exchange or Exchange Online related to invalid X500 addresses.
Unified and professional email signatures help maintain a consistent company brand image to the outside world. This article shows how to create an email signature in Exchange Server 2010 using a transport rule and how to overcome native limitations …
In this video we show how to create an email address policy 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 Mail Flow…
The video tutorial explains the basics of the Exchange server Database Availability groups. The components of this video include: 1. Automatic Failover 2. Failover Clustering 3. Active Manager
Suggested Courses
Course of the Month9 days, 9 hours left to enroll

762 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