Option Explicit
Const strWorkbook As String = "C:\Path\Forums\OutlookFolders.xlsx"
Const strSheet As String = "Sheet1"
Private olNS As Outlook.NameSpace
Private olFolder As Outlook.Folder
Private olCheck As Folder
Private strFolders As String
Private lngRow As Long
Private Arr() As Variant

Sub AddFolderListFromExcel()
'Graham Mayor - www.gmayor.com
    strFolders = ""
    On Error Resume Next
    Set olNS = GetNamespace("MAPI")
    Set olFolder = olNS.PickFolder
    Arr = xlFillArray(strWorkbook, strSheet)
    For lngRow = 0 To UBound(Arr, 2)
        olFolder.folders.Add Arr(0, lngRow)
        strFolders = strFolders & Arr(0, lngRow) & vbNewLine
    Next lngRow
    MsgBox strFolders & vbNewLine & "added to " & olFolder
lbl_Exit:
    Set olFolder = Nothing
    Exit Sub
End Sub

Sub DeleteFolderListFromExcel()
'Graham Mayor - www.gmayor.com
    strFolders = ""
    On Error Resume Next
    Set olNS = GetNamespace("MAPI")
    Set olFolder = olNS.PickFolder
    Arr = xlFillArray(strWorkbook, strSheet)
    For lngRow = 0 To UBound(Arr, 2)
        olFolder.folders(Arr(0, lngRow)).Delete
        strFolders = strFolders & Arr(0, lngRow) & vbNewLine
    Next lngRow
    MsgBox strFolders & vbNewLine & "deleted from " & olFolder
lbl_Exit:
    Set olFolder = Nothing
    Exit Sub
End Sub

Private Function xlFillArray(strWorkbook As String, _
                             strWorksheetName As String) As Variant
'Graham Mayor - www.gmayor.com
Dim RS As Object
Dim CN As Object
Dim iRows As Integer

    strWorksheetName = strWorksheetName & "$]"
    Set CN = CreateObject("ADODB.Connection")
    CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & strWorkbook & ";" & _
                              "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1

    With RS
        .MoveLast
        iRows = .RecordCount
        .MoveFirst
    End With
    xlFillArray = RS.GetRows(iRows)
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function