Listfolders.bas

Sub listfolders 'puts list of outlook files/folders on clipboard for pasting to word/excel for debugging Dim txtreport As String Dim objNS As Outlook.NameSpace Dim i, j As Integer Set objNS = Application.GetNamespace("MAPI") Dim objMsg As New DataObject i = 1 txtreport = "File and Folder List---" & Constants.vbNewLine While (i <= objNS.Folders.Count) j = 1 txtreport = txtreport & "******************************" & Constants.vbNewLine txtreport = txtreport & objNS.Folders.Item(i).Name & Constants.vbNewLine While (j <= objNS.Folders.Item(i).Folders.Count) txtreport = txtreport & "  " & objNS.Folders.Item(i).Folders.Item(j).Name & Constants.vbNewLine j = j + 1 Wend i = i + 1 Wend objMsg.SetText txtreport objMsg.PutInClipboard MsgBox "File/Folder list is on the clipboard to be pasted into Word or Excel" '    Set objNS = Nothing Set objMsg = Nothing End Sub