エクセルに入力されたｱﾄﾞﾚｽを取得してファイルを開く。
実行にあたっては下図のような表をあらかじめ作成しており、
かつフォルダは既に存在するものとする。

＜サンプル＞
'フォルダは既に存在していると仮定する
'→存在しない場合は最深の階層から右へ三つのセルへエラーを表記する

    Dim FolPath As String
    Dim c As Long
    Dim i As Long '処理を行っている階層の位置
    Dim x As Long

    Const goA As String = "A4" 'ディレクトリの最上層が書かれたセル位置
    Const InGyo As Long = 4 '処理を始める行（二回目以降の処理は五行目から行う）

Sub 一括でフォルダを開く()
    Dim R As Long

    Dim myLink() As String '出力したことのあるｱﾄﾞﾚｽを格納する
    ReDim Preserve myLink(0)
    Dim co As Long

    Dim n As Long '処理を行っているフォルダ


    '二回目（5行目）以降で使用
    '～子ディレクトリがない→ループから抜ける
    '1回目のfalse　：　親ディレクトリの空白取得中
    'true　　　　　：　空白ではない
    '2回目のfalse　：　再度空白になった→ループから抜ける
    Dim chF As Boolean

    R = Range(goA).CurrentRegion.Rows.Count 'ディレクトリの最大数
    c = Range(goA).CurrentRegion.Columns.Count '階層の深さ


    '～～～4行目のディレクトリを構築する
    n = InGyo '行を取得
    '-1:パスを取得する
    '一旦、FolPathを空白にする
    FolPath = ""
    x = n
    For i = 1 To c '列を取得
        Call GetFolPath
    Next i

    '-2:ファイルを開く
    Call OpenFolPath


'    '～～～5行目以降の処理を行う
    For n = InGyo + 1 To 3 + R
        'フラグを初期値にする
        chF = False

        '一旦、FolPathを空白にする
        FolPath = ""

        '浅い階層から深い階層へアドレスを読み進める
        For i = 1 To c
            '-0：変数ｘ = FolPathへ代入するｱﾄﾞﾚｽ（列数）
            x = n '

            If Cells(n, i).Value = "" Then
                '空白の場合・・・
                '1：chFがtrue→次の行に移動
                If chF = True Then
                    Exit For
                End If

                '2:chFがfalse→上の列を読み込む(最大InGyo-1行目まで）
                Do While Cells(x, i).Value = ""
                    If x = InGyo - 1 Then
                    '読み込み始めの行InGyoよりも上の行になったら処理を中止する
                        Exit Do
                    Else
                        x = x - 1
                    End If
                Loop
            ElseIf Cells(n, i).Value <> "" Then
                '空白でない場合はその値をFolPathへ
                chF = True
            End If

            '-1:パスを取得する
            Call GetFolPath
        Next i

        'ファイルを開く
        Call OpenFolPath
    Next n

    MsgBox "処理が完了しました"
End Sub

Private Sub GetFolPath()
    If FolPath = "" Then
        '一番上の階層
        FolPath = Cells(x, i).Value
    ElseIf Cells(x, i).Value <> "" Then
        FolPath = FolPath & "\" & Cells(x, i).Value
    End If
End Sub

Private Sub OpenFolPath()
    Dim WSH As Object

    '-2:FolPathが存在するか？
    If Dir(FolPath, vbDirectory) = "" Then
        'フォルダが存在しない
        '→エラー表記を行う
        Cells(x, c + 3).Value = "ファイルが存在しません"
    Else
        'フォルダが存在する
        '→フォルダを開く
        Set WSH = CreateObject("Wscript.Shell")
        WSH.Run FolPath, 2
        Set WSH = Nothing
    End If
End Sub

（作成例）エクセルの表を元に、フォルダを開く