5 thoughts on “List all folders in a Microsoft Outlook account”

1. Paste this code in:
   Outlook VB or Excel VB ?

2. Excel.

3. Sub mappen_Outlookmappenstruktuur()
For Each fld In CreateObject("outlook.Application").GetNamespace("MAPI").Folders
c01 = c01 & vbCr & fld.Name

   For Each fld1 In fld.Folders
   c01 = c01 & vbCr & fld1.Name & "|" & fld1.Size & "|" & fld1.Items.Count
   For Each fld2 In fld1.Folders
   c01 = c01 & vbCr & "|" & fld2.Name & "|" & fld2.Items.Count
   Next
   Next
   Next

   Cells(1).Resize(UBound(Split(c01, vbCr))) = Application.Transpose(Split(Mid(c01, 2), vbCr))
Columns(1).TextToColumns , 1, -4142, , False, False, False, False, True, "|"
End Sub

4. The best place I have found so far for anything related to Outlook vba is Sue Mosher’s web site:
   http://www.outlookcode.com/

   Lots of useful examples can be found in:
   http://www.outlookcode.com/member/jump2007.zip

   One of them seems to correspond to your issue: Listing 13.11 – List the folders and number of items in the current Outlook session (VBA).

   Bert

5. Sub Add_Checkdigit()

   lastrow = ActiveSheet.UsedRange.Rows.Count
   Range(Cells(2, “A”), Cells(lastrow, “A”)).Select
   With Selection
   Set c = .Find(“”, LookIn:=xlValues)
   If Not c Is Nothing Then
   lastrow = c.Row – 1
   End If
   End With
   Range(Cells(2, “A”), Cells(lastrow, “A”)).Select

   If Selection.Rows.Count = 1 Then
   ReDim Data(1, 1)
   Data(1, 1) = Selection
   Else
   Data = Selection
   End If
   For x = 1 To UBound(Data)
   strContainerNumber = Data(x, 1)

   ‘check for missing leading zero

   For A = 1 To 4
   checker = Mid(strContainerNumber, A, 1)
   If IsNumeric(Val(checker)) Then b = b + 1
   Next
   If b > 1 Then
   If Len(Mid(strContainerNumber, 5)) = 5 And IsNumeric(Mid(strContainerNumber, 5)) Then
   strContainerNumber = Left(strContainerNumber, 4) & “0” & Right(strContainerNumber, 5)
   End If
   End If

   If Len(strContainerNumber) >= 11 Or Len(strContainerNumber) < 9 Then 'exit function if check digit is already included
   'Exit For
   Else
   'declarations
   Dim strDigit As String
   Dim intDigitValue As Integer
   Dim lngTotalDigitValue As Long
   Dim intCheckDigit As Integer
   Dim intLoopCounter As Integer
   Dim intMultiplier As Integer

   Let intLoopCounter = 1
   Let intMultiplier = 1
   Let lngTotalDigitValue = 0

   'get total digit value
   Do While intLoopCounter <= 10
   Let strDigit = UCase(Mid(strContainerNumber, intLoopCounter, 1))
   Select Case strDigit
   Case "A"
   Let intDigitValue = 10
   Case "B"
   Let intDigitValue = 12
   Case "C"
   Let intDigitValue = 13
   Case "D"
   Let intDigitValue = 14
   Case "E"
   Let intDigitValue = 15
   Case "F"
   Let intDigitValue = 16
   Case "G"
   Let intDigitValue = 17
   Case "H"
   Let intDigitValue = 18
   Case "I"
   Let intDigitValue = 19
   Case "J"
   Let intDigitValue = 20
   Case "K"
   Let intDigitValue = 21
   Case "L"
   Let intDigitValue = 23
   Case "M"
   Let intDigitValue = 24
   Case "N"
   Let intDigitValue = 25
   Case "O"
   Let intDigitValue = 26
   Case "P"
   Let intDigitValue = 27
   Case "Q"
   Let intDigitValue = 28
   Case "R"
   Let intDigitValue = 29
   Case "S"
   Let intDigitValue = 30
   Case "T"
   Let intDigitValue = 31
   Case "U"
   Let intDigitValue = 32
   Case "V"
   Let intDigitValue = 34
   Case "W"
   Let intDigitValue = 35
   Case "X"
   Let intDigitValue = 36
   Case "Y"
   Let intDigitValue = 37
   Case "Z"
   Let intDigitValue = 38
   Case "0"
   Let intDigitValue = 0
   Case "1"
   Let intDigitValue = 1
   Case "2"
   Let intDigitValue = 2
   Case "3"
   Let intDigitValue = 3
   Case "4"
   Let intDigitValue = 4
   Case "5"
   Let intDigitValue = 5
   Case "6"
   Let intDigitValue = 6
   Case "7"
   Let intDigitValue = 7
   Case "8"
   Let intDigitValue = 8
   Case "9"
   Let intDigitValue = 9
   End Select
   Let lngTotalDigitValue = intDigitValue * intMultiplier + lngTotalDigitValue
   Let intLoopCounter = intLoopCounter + 1
   Let intMultiplier = intMultiplier + intMultiplier
   Loop

   'divid the total digit value by 11. the remainder is the check digit
   Let intCheckDigit = lngTotalDigitValue Mod 11
   'if the check remainder equals 10 then the check digit is 0
   If intCheckDigit = 10 Then
   Let intCheckDigit = 0
   End If

   'combind the container number and the check digit
   Data(x, 1) = UCase(strContainerNumber) & intCheckDigit
   End If
   Next
   If Selection.Rows.Count = 1 Then
   Selection = Data(1, 1)
   Else
   Selection = Data
   End If

   End Sub

---

Posting code? Use <pre> tags for VBA and <code> tags for inline.