dcsimg
Results 1 to 2 of 2

Thread: List Outlook Folder Names - Help to Modify Code

  1. #1

    Thread Starter
    New Member
    Join Date
    Oct 2012
    Posts
    10

    List Outlook Folder Names - Help to Modify Code

    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

  2. #2
    PowerPoster SamOscarBrown's Avatar
    Join Date
    Aug 2012
    Location
    NC, USA
    Posts
    6,978

    Re: List Outlook Folder Names - Help to Modify Code

    once you close your textfile (objTextFile.Close) , add a msgbox....will that suffice?

    don't forget to use option Explicit and dimension all your variables

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width