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. |
|
|
Thread Tools | Search this Thread | Display Modes |
#1
|
|||
|
|||
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
|
|||
|
|||
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 |
Display Modes | |
|
|
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 |