Solved

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

Posted on 2010-08-25
6
811 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
Comment Utility
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
Comment Utility
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
Comment Utility
The path "supportmail\Inbox" must not be valid.  Is "supportmail" the way the folder name appears in the navigation pane?
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

Author Comment

by:mattinvt
Comment Utility
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
Comment Utility
Thanks!

See the function that came out of this.

0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
You're welcome!
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Utilizing an array to gracefully append to a list of EmailAddresses
We are happy to announce a brand new addition to our line of acclaimed email signature management products – CodeTwo Email Signatures for Office 365.
In this video we show how to create a Resource Mailbox in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: Navigate to the Recipients >> Resources tab.: "Recipients" is our default selection …
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…

771 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

12 Experts available now in Live!

Get 1:1 Help Now