Windows Explored

Public Sub ExportFolderNames()
Dim F As Outlook.MAPIFolder
Dim Folders As Outlook.Folders

Set F = Application.ActiveExplorer.CurrentFolder
Set Folders = F.Folders

Dim Result As Integer
Result = MsgBox("Do you want to structure the output?", vbYesNo + vbDefaultButton2 + vbApplicationModal, "Output structuring")
If Result = 6 Then
Structured = True
Else
Structured = False
End If

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
End Sub

Public Sub ExportFolderNamesSelect()
Dim F As Outlook.MAPIFolder
Dim Folders As Outlook.Folders

Set F = Application.Session.PickFolder

If Not F Is Nothing Then
Set Folders = F.Folders

Dim Result As Integer
Result = MsgBox("Do you want to structure the output?", vbYesNo + vbDefaultButton2 + vbApplicationModal, "Output structuring")
If Result = 6 Then
Structured = True
Else
Structured = False
End If

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
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 As Outlook.Folders)
Dim F As Outlook.MAPIFolder

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

Private Sub WriteToATextFile(OLKfoldername As String)
fnum = FreeFile()

Open MyFile For Append As #fnum
Print #fnum, OLKfoldername
Close #fnum
End Sub

Private Function StructuredFolderName(OLKfolderpath As String, OLKfoldername As String) As String
If Structured = False Then
StructuredFolderName = Mid(OLKfolderpath, 3)
Else
Dim i As Integer
i = Len(OLKfolderpath) – Len(Replace(OLKfolderpath, "\", ""))

Dim x As Integer
Dim OLKprefix As String
For x = Base To i
OLKprefix = OLKprefix & "-"
Next x

StructuredFolderName = OLKprefix & OLKfoldername
End If
End Function