Solved: Revisit "Export Folder Names to Excel "

[Jomili]

In a previous post ( http://www.vbaexpress.com/forum/showthread.php?t=33231 ) I got a macro running that would copy my folders from Outlook into an Excel spreadsheet. At the time, my Excel and Outlook were at version 2003. Now I'm at 2010. The previous code still works just fine in the original workbook with Excel 2010 and Outlook 2010, but I'd like to use the code in my Personal.xlsm, from any workbook, and I'm having trouble getting it to work. See the link above for the final corrected code I'm starting from.

In that last post the macro was initiated by a Command button on the activesheet. To use the macro from my Personal.xlsb I changed that Command button to the "OutlookFolders" sub. The error I'm hitting is on the "Set rngPath" line of the "ProcessFolder" macro. I get a "Runtime error 1004: Application-defined or Object-defined error". I'd appreciate any help I can get on this.

Thanks in advance,
John

Sub OutlookFolders()
'Used to keep track of the number of folders
Dim lCountOfFound As Long
'The output range
Dim rngPath As Range
'Starting the row number off
RowNo = 1
'Call this sub procedure
WalkFolders
End Sub

Sub WalkFolders()
Dim olApp As Outlook.Application
Dim olSession As Outlook.Namespace
Dim olStartFolder As Outlook.MAPIFolder
Dim lCountOfFound As Variant
lCountOfFound = 0
Set olApp = New Outlook.Application
Set olSession = olApp.GetNamespace("MAPI")
' Allow the user to pick the folder in which to start the search.
'or use GetDefaultFolder(olFolderInbox).Parent instead of the PickFolder
Set olStartFolder = olSession.PickFolder
' Check to make sure user didn't cancel PickFolder dialog.
If Not (olStartFolder Is Nothing) Then
' Start the search process.
ProcessFolder olStartFolder
End If
End Sub

Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
Dim rngPath As Range
Set rngPath = cells(RowNo, 1)
Dim i As Long
Dim olNewFolder As Outlook.MAPIFolder
' late bind this object variable, since it could be various item types
Dim olTempFolder As Outlook.MAPIFolder
Dim olTempFolderPath As String
Dim lCountOfFound As Variant
' Loop through the items in the current folder.
' Looping through backwards in case items are to be deleted,
' as this is the proper way to delete items in a collection.
For i = CurrentFolder.Folders.Count To 1 Step -1
Set olTempFolder = CurrentFolder.Folders(i)
'Puts File Path into Excel here
olTempFolderPath = olTempFolder.FolderPath
cells(RowNo, 1) = olTempFolderPath
RowNo = RowNo + 1
lCountOfFound = lCountOfFound + 1
Next
' Loop through and search each subfolder of the current folder.
For Each olNewFolder In CurrentFolder.Folders
'Don't need to process the Deleted Items folder
If olNewFolder.Name <> "Deleted Items" Then
ProcessFolder olNewFolder
End If
Next
AppActivate Application.Caption

End Sub

[slpowell]

Hi,

Try defining RowNo outside of outlookFolders. Right now it's a local variable so when it gets to that line, RowNo is actually empty because it hasn't been defined yet locally. You could also put "Option Explicit" at the top and it will complain if anything isn't properly defined, which is helpful in avoiding this problem and misspelled names.

Dim RowNo

Sub OutlookFolders()
....

Best regards,

Steve

[Jomili]

Steve,

Thanks for replying. That "Option Explicit" comment is one I ALWAYS need to remember; it's tripped me up a few times. After posting I continued working with it, and got it working as shown below. So, unless you have any ideas on how I can make it better, I think this one is solved.

Thanks,
John

Sub Outlook_ListMyFolders()
'---------------------------------------------------------------------------------------
' Procedure : Outlook_ListMyFolders
' Author : jomili
' Date : 7/23/2012
' Purpose : Lists all subfolders of the selected Outlook directory
'---------------------------------------------------------------------------------------
Dim olApp As Outlook.Application
Dim olSession As Outlook.Namespace
Dim olStartFolder As Outlook.MAPIFolder
Dim lCountOfFound As Variant
lCountOfFound = 0
Set olApp = New Outlook.Application
Set olSession = olApp.GetNamespace("MAPI")
' Allow the user to pick the folder in which to start the search.
'or use GetDefaultFolder(olFolderInbox).Parent instead of the PickFolder
Set olStartFolder = olSession.PickFolder
' Check to make sure user didn't cancel PickFolder dialog.
If Not (olStartFolder Is Nothing) Then

' Start the search process.
ProcessFolder olStartFolder
End If
Application.ScreenUpdating = True
End Sub


Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
'Used by Outlook_ListMyFolders
Application.ScreenUpdating = False
Dim rngPath As Range
RowNo = Range("A" & Rows.Count).End(xlUp).Row 'this tells where our last row is
Set rngPath = cells(RowNo, 1)
Dim i As Long
Dim olNewFolder As Outlook.MAPIFolder
' late bind this object variable, since it could be various item types
Dim olTempFolder As Outlook.MAPIFolder
Dim olTempFolderPath As String
Dim lCountOfFound As Variant
' Loop through the items in the current folder.
' Looping through backwards in case items are to be deleted,
' as this is the proper way to delete items in a collection.
For i = CurrentFolder.Folders.Count To 1 Step -1
Set olTempFolder = CurrentFolder.Folders(i)
'Puts File Path into Excel here
olTempFolderPath = olTempFolder.FolderPath
cells(RowNo, 1) = olTempFolderPath
RowNo = RowNo + 1
lCountOfFound = lCountOfFound + 1
Next
' Loop through and search each subfolder of the current folder.
For Each olNewFolder In CurrentFolder.Folders
'Don't need to process the Deleted Items folder
If olNewFolder.Name <> "Deleted Items" Then
ProcessFolder olNewFolder
End If
Next
AppActivate Application.Caption

End Sub