VBAでフォルダ階層を生成したい

Question

###実現したいこと
B2セルに入力されたパスにB5以降のセル情報を基にフォルダ階層を自動生成するVBAを作成したい

###バージョン
▽VBA
Microsoft Visual Basic for Applications 7.1
Version 1068
VBA: Retail 7.1.1068

▽Excel
Excel2013

###コードの参照元
https://fastclassinfo.com/entry/makefolders/

###内容
下記コードだと、コンパイル時にThenや;の部分でエラーが発生してしまいます。
参照元のサイトに記載のあった拡張機能は追加しているのですが、エラーが消えません。
上記のバージョンだと使用できない構文が混ざっているためでしょうか。
VBAに関する知識が乏しく、調べても分からなかったため今回質問させていただきました。
こちらのエラーを解決できる方がいらっしゃれば、ご回答をよろしくお願いします。

###3/9追記
下記コードyureighostさんに修正していただきましたが、自分の環境だと実行時にエラーやメッセージは表示されずフォルダも生成されない状態で処理が終了してしまいます。
何度見返してもどこが間違っているのか自分では判断がつかないため、ご存知であればご教示のほどよろしくお願いします。

3/9再追記
セルに数式が入力されている状態だとうまくマクロが処理してくれないみたいで、数式を消すことでフォルダが正常に作成されました。

###コード

Option Explicit
Sub makefolder()
    Dim i As Long, cmax As Long, x As Long, z As Long, cnt As Long, j As Long, k As Long
    Dim ws1 As Worksheet
    Dim str As String, url As String
    Dim s As String, s1 As String
    Dim n1 As Long
    Dim fs As FileSystemObject
    Set fs = New Scripting.FileSystemObject
    Set ws1 = Worksheets("フォルダ作成")
    cmax = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    cnt = ws1.Cells(4, Columns.Count).End(xlToLeft).Column

    '[1] セルB2にURLが記載されているかチェック
    If ws1.Range("B2").Value = "" Then
        MsgBox "セルB2に「作成先のフォルダURL」を入力して下さい"
        ws1.Range("B2").Activate
        Exit Sub
    End If

    url = ws1.Range("B2").Value

    '[2] 同じ行に複数回記入されていないことを確認
    For i = 5 To cmax
        x = 0
        For j = 0 To cnt - 2
            If ws1.Cells(i, 2).Offset(0, j).Value <> "" Then
                x = x + 1
            End If
        Next

        If x > 1 Then
            z = z + 1
        End If
    Next

    '[3] 同じ行に複数回記入されていた場合、処理を止める
    If z > 0 Then
        MsgBox "入力情報を見直してください"
        Exit Sub
    End If

    '[4] 階層別にフォルダを作成する
    For j = 0 To cnt - 2
        For i = 5 To cmax
            If ws1.Cells(i, 2).Offset(0, j).Value <> "" Then
                s1 = ws1.Cells(i, 2).Offset(0, j).Value

                For k = 0 To j
                    If k - j = 0 Then
                        Exit For
                    End If
                    n1 = ws1.Cells(i, 2).Offset(0, j - k - 1).End(xlUp).Row
                    s1 = ws1.Cells(n1, 2).Offset(0, j - k - 1).Value & "\" & s1
                Next

                s = url & "\" & s1
                fs.CreateFolder s
            End If
        Next
    Next

    Set fs = Nothing
End Sub　

Answer 1

確かに記述が全然違いますね。
ただ<>のエスケープとかはHTMLの物なので
さすがに使われていたとは思えないですが。
とりあえず構文のおかしいところを修正すれば動作はしました。

Option Explicit
Sub makefolder()
    Dim i As Long, cmax As Long, x As Long, z As Long, cnt As Long, j As Long, k As Long
    Dim ws1 As Worksheet
    Dim str As String, url As String
    Dim s As String, s1 As String
    Dim n1 As Long
    Dim fs As FileSystemObject
    Set fs = New Scripting.FileSystemObject
    Set ws1 = Worksheets("フォルダ作成")
    cmax = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    cnt = ws1.Cells(4, Columns.Count).End(xlToLeft).Column

    '[1] セルB2にURLが記載されているかチェック
    If ws1.Range("B2").Value = "" Then
        MsgBox "セルB2に「作成先のフォルダURL」を入力して下さい"
        ws1.Range("B2").Activate
        Exit Sub
    End If

    url = ws1.Range("B2").Value

    '[2] 同じ行に複数回記入されていないことを確認
    For i = 5 To cmax
        x = 0
        For j = 0 To cnt - 2
            If ws1.Cells(i, 2).Offset(0, j).Value <> "" Then
                x = x + 1
            End If
        Next

        If x > 1 Then
            z = z + 1
        End If
    Next

    '[3] 同じ行に複数回記入されていた場合、処理を止める
    If z > 0 Then
        MsgBox "入力情報を見直してください"
        Exit Sub
    End If

    '[4] 階層別にフォルダを作成する
    For j = 0 To cnt - 2
        For i = 5 To cmax
            If ws1.Cells(i, 2).Offset(0, j).Value <> "" Then
                s1 = ws1.Cells(i, 2).Offset(0, j).Value

                For k = 0 To j
                    If k - j = 0 Then
                        Exit For
                    End If
                    n1 = ws1.Cells(i, 2).Offset(0, j - k - 1).End(xlUp).Row
                    s1 = ws1.Cells(n1, 2).Offset(0, j - k - 1).Value & "\" & s1
                Next

                s = url & "\" & s1
                fs.CreateFolder s
            End If
        Next
    Next

    Set fs = Nothing
End Sub

Comments

[DreamTheater]

HTML化するときにしくじったのでしょうね。

[d_96a]

コードを修正していただきありがとうございます。
ただ修正していただいたコードを実行した際フォルダが作成されることはありませんでした。
コンパイルエラーも発生しませんでした。
yureighostさんの環境ではフォルダが生成されたのでしょうか。

[yureighost]

ちゃんとフォルダ作成されました。
使い方に関しては参考にされたサイトの説明の通りなので試してみてください。

[d_96a]

ご回答ありがとうございます。
サイトの通りにしても、なぜか私の環境ではaaaのフォルダが作成された後何も起きませんでした。
もう少し色々触ってみようと思います。

Answer 2

改めてコードを読みましたが、そもそも参考にされたサイトのコード自体がダメですね。。。
あれではコンパイル通りません。
If文の条件式に右辺がなかったり、不等号がHTMLエンコード文字だったり、、、

ちょっと解読に時間が掛かりそうで、本日中のフォローは難しそうです。（ごめんなさい）

Comments

[d_96a]

なるほど、やはりif文の構文等がおかしかったのですね。
わざわざ見ていただかありがとうございます。
お時間ある時にご回答いただけると幸いです。