A Microsoft Outlook email forum. Outlook Banter

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » Outlook Banter forum » Microsoft Outlook Email Newsgroups » Outlook and VBA
Site Map Home Register Authors List Search Today's Posts Mark Forums Read Web Partners

Trying to run this macro to save Outlook mailbox folder list - but it doesn't work



 
 
Thread Tools Search this Thread Display Modes
  #1  
Old November 19th 08, 09:52 PM posted to microsoft.public.outlook.program_vba
Hubert
external usenet poster
 
Posts: 3
Default Trying to run this macro to save Outlook mailbox folder list - but it doesn't work

I found this code on the net. It suppose to copy a user mailbox folder list
to a .txt file( the one you see in the left pane ). When I run it, i get an
error :

"Runtime error 429: ActiveX component cannot create object "
and " Set objCDO = CreateObject("MAPI.Session") " is highlighted in yellow.
Can anyone see why i get this error. Maybe there is a simpler way to save
Outlook mail folder list to a file. btw, i'm running this off Outlook 2007
in the exchange setup. Any tips/advice would be appreciated.



Dim objFile As Object

Sub EnumerateOutlookFolderStructure()
Dim objCDO As Object, _
objStore As Object, _
objFSO As Object, _
olkFolder As Outlook.MAPIFolder
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Change the file name and path on the follwoing line as desired
Set objFile = objFSO.CreateTextFile("C:\Outlook.txt", True)
Set objCDO = CreateObject("MAPI.Session")
'Change the profile name as needed
objCDO.Logon "new"
For Each objStore In objCDO.InfoStores
objFile.WriteLine objStore.Name
Set olkFolder = OpenMAPIFolder("\" & objStore.Name)
EnumerateSubFolders olkFolder, 1
Next
objCDO.Logoff
Set objCDO = Nothing
Set objStore = Nothing
Set objFSO = Nothing
Set olkFolder = Nothing
objFile.Close
Set objFile = Nothing
MsgBox "All done!"
End Sub

Sub EnumerateSubFolders(olkFolder As Outlook.MAPIFolder, intLevel As
Integer)
Dim olkSubFolder As Outlook.MAPIFolder
For Each olkSubFolder In olkFolder.Folders
objFile.WriteLine Space(intLevel * 2) & olkSubFolder.Name
EnumerateSubFolders olkSubFolder, intLevel + 1
Next
Set olkSubFolder = Nothing
End Sub

'Credit where credit is due.
'The code below is not mine. I found it somewhere on the internet but do
'not remember where or who the author is. The original author(s) deserves
all
'the credit for these functions.
Function OpenMAPIFolder(szPath)
Dim app, ns, flr, szDir, I
Set flr = Nothing
Set app = CreateObject("Outlook.Application")
If Left(szPath, Len("\")) = "\" Then
szPath = Mid(szPath, Len("\") + 1)
Else
Set flr = app.ActiveExplorer.CurrentFolder
End If
While szPath ""
I = InStr(szPath, "\")
If I Then
szDir = Left(szPath, I - 1)
szPath = Mid(szPath, I + Len("\"))
Else
szDir = szPath
szPath = ""
End If
If IsNothing(flr) Then
Set ns = app.GetNamespace("MAPI")
Set flr = ns.Folders(szDir)
Else
Set flr = flr.Folders(szDir)
End If
Wend
Set OpenMAPIFolder = flr
End Function

Function IsNothing(obj)
If TypeName(obj) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function



Ads
  #2  
Old November 20th 08, 06:23 PM posted to microsoft.public.outlook.program_vba
Michael Bauer [MVP - Outlook]
external usenet poster
 
Posts: 1,885
Default Trying to run this macro to save Outlook mailbox folder list - but it doesn't work



You'd need to install the CDO 1.21 library on your computer. But instead you
could also rewrite the code and use Outlook objects instead of CDO. Here's
an example for how to loop recursively through the folder using Outlook
objects:

http://www.vboffice.net/sample.html?...cmd=showite m

--
Best regards
Michael Bauer - MVP Outlook

: Outlook Categories? Category Manager Is Your Tool
: VBOffice Reporter for Data Analysis & Reporting
: http://www.vboffice.net/product.html?pub=6&lang=en


Am Wed, 19 Nov 2008 15:52:20 -0500 schrieb Hubert:

I found this code on the net. It suppose to copy a user mailbox folder

list
to a .txt file( the one you see in the left pane ). When I run it, i get

an
error :

"Runtime error 429: ActiveX component cannot create object "
and " Set objCDO = CreateObject("MAPI.Session") " is highlighted in

yellow.
Can anyone see why i get this error. Maybe there is a simpler way to save
Outlook mail folder list to a file. btw, i'm running this off Outlook 2007
in the exchange setup. Any tips/advice would be appreciated.



Dim objFile As Object

Sub EnumerateOutlookFolderStructure()
Dim objCDO As Object, _
objStore As Object, _
objFSO As Object, _
olkFolder As Outlook.MAPIFolder
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Change the file name and path on the follwoing line as desired
Set objFile = objFSO.CreateTextFile("C:\Outlook.txt", True)
Set objCDO = CreateObject("MAPI.Session")
'Change the profile name as needed
objCDO.Logon "new"
For Each objStore In objCDO.InfoStores
objFile.WriteLine objStore.Name
Set olkFolder = OpenMAPIFolder("\" & objStore.Name)
EnumerateSubFolders olkFolder, 1
Next
objCDO.Logoff
Set objCDO = Nothing
Set objStore = Nothing
Set objFSO = Nothing
Set olkFolder = Nothing
objFile.Close
Set objFile = Nothing
MsgBox "All done!"
End Sub

Sub EnumerateSubFolders(olkFolder As Outlook.MAPIFolder, intLevel As
Integer)
Dim olkSubFolder As Outlook.MAPIFolder
For Each olkSubFolder In olkFolder.Folders
objFile.WriteLine Space(intLevel * 2) & olkSubFolder.Name
EnumerateSubFolders olkSubFolder, intLevel + 1
Next
Set olkSubFolder = Nothing
End Sub

'Credit where credit is due.
'The code below is not mine. I found it somewhere on the internet but do
'not remember where or who the author is. The original author(s) deserves
all
'the credit for these functions.
Function OpenMAPIFolder(szPath)
Dim app, ns, flr, szDir, I
Set flr = Nothing
Set app = CreateObject("Outlook.Application")
If Left(szPath, Len("\")) = "\" Then
szPath = Mid(szPath, Len("\") + 1)
Else
Set flr = app.ActiveExplorer.CurrentFolder
End If
While szPath ""
I = InStr(szPath, "\")
If I Then
szDir = Left(szPath, I - 1)
szPath = Mid(szPath, I + Len("\"))
Else
szDir = szPath
szPath = ""
End If
If IsNothing(flr) Then
Set ns = app.GetNamespace("MAPI")
Set flr = ns.Folders(szDir)
Else
Set flr = flr.Folders(szDir)
End If
Wend
Set OpenMAPIFolder = flr
End Function

Function IsNothing(obj)
If TypeName(obj) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function

 




Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Outlook macro return Runtime error : operation failed for mailbox Shiv Outlook and VBA 3 October 6th 08 03:00 PM
Outlook 2003: Is there any way of making the contacts list of asecondary mailbox appear in the address book drop down list? QH Outlook - Installation 1 May 16th 08 11:14 AM
Outlook 2003: Is there any way of making the contacts list of asecondary mailbox appear in the address book drop down list? QH Outlook - Using Contacts 1 May 16th 08 11:14 AM
Save Password for Exchange Mailbox airbornz Outlook - Installation 0 May 28th 07 04:30 AM
Save Attachment Using Macro [email protected] Outlook and VBA 3 August 8th 06 03:42 PM


All times are GMT +1. The time now is 11:07 AM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.Search Engine Friendly URLs by vBSEO 2.4.0
Copyright ©2004-2024 Outlook Banter.
The comments are property of their posters.