I found this code which I've modified a bit and works great, but I'm wondering if someone can help me make it better. This script creates a txt file on your desktop and lists all of the Outlook Folder Names (including all sub folders).

The code creates the txt on your desktop right away, which is not ideal. It's hard to know when the process is finished. In my case I have an email account with over one hundred folders to manage and if I open the txt file too soon I only see a partial list of results. I can close and reopen the txt file over and watch the list grow. But I would prefer to adjust the code to do either one of the following:

Option 1) Could this code be adjusted to not use a txt file but instead use a msgbox to post the results when the process is complete? This would be most ideal. However I can imagine if the results are many a message box many not work.

Option 2) Could this code be adjusted to wait until the process is compeltely finished, then launch/open the txt file automatically?

Thanks so much for your help and expertise, this is a great forum for newbs like me.


Code:
Dim MyFile, Structured, Base

Call ExportFolderNamesSelect()

Public Sub ExportFolderNamesSelect()
  Dim objOutlook
  Set objOutlook = CreateObject("Outlook.Application")

  Dim F, Folders
  Set F = objOutlook.Session.PickFolder
  
  If Not F Is Nothing Then
    Set Folders = F.Folders

    MyFile = GetDesktopFolder() & "\outlookfolders.txt"
    Base = Len(F.FolderPath) - Len(Replace(F.FolderPath, "\", "")) + 1

    WriteToATextFile (StructuredFolderName(F.FolderPath, F.Name))
  
    LoopFolders Folders
  
    Set F = Nothing
    Set Folders = Nothing
    Set objOutlook = Nothing
  End If
End Sub

Private Function GetDesktopFolder()
  Dim objShell
  Set objShell = CreateObject("WScript.Shell")
  GetDesktopFolder = objShell.SpecialFolders("Desktop")
  Set objShell = Nothing
End Function

Private Sub LoopFolders(Folders)
  Dim F
    
  For Each F In Folders
    WriteToATextFile (StructuredFolderName(F.FolderPath, F.Name))
    LoopFolders F.Folders
  Next
End Sub

Private Sub WriteToATextFile(OLKfoldername)
  Dim objFSO, objTextFile
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objTextFile = objFSO.OpenTextFile (MyFile, 8, True)
  objTextFile.WriteLine (OLKfoldername)
  objTextFile.Close
  Set objFSO = Nothing
  Set objTextFile = Nothing
End Sub

Private Function StructuredFolderName(OLKfolderpath, OLKfoldername)
    StructuredFolderName = Mid(OLKfolderpath, 3)
End Function