VBAでJSONを扱う場合はこれを読むといい

VBAでJSONを活用する方法

こちらのVBAコードは、指定したフォーマットに従ってフォルダを作成するExcelマクロです。

余談なので不要な場合は、次へおすすみください。
今回、VBAでJSONを活用する方法の一番活用例がありそうなものを選びました。
そのほかにもいろいろな方法で、自分は利用しています。
例えば、VBAで作成した発注書作成システムなどでは、
ブックを開いた際の初期化で、init設定を読み込み、
現在の環境などをJSON形式で呼び出せるようにしたりしてます。

なお、ほかの言語でも同様にJSON形式でConfigを初期起動で呼び出せるようにしているため、
使い慣れた方法で、VBAでも実装したく実現させました。

使用するライブラリ

今回使用したライブラリと一部該当するコードの例です。

Microsoft Scripting Runtime -> 参照先
JsonConverter -> VBA-JSON

Function strFormat(ByVal inputString As String, outputString As Variant) As String
    On Error Resume Next
    Dim regexPattern As String
    regexPattern = "\$\{.*?\}"
    
    Dim regex As New RegExp
    regex.Global = True
    regex.Pattern = regexPattern
    
    Dim dict As Object
    Set dict = JsonConverter.ParseJson(JsonConverter.ConvertToJson(outputString))

    Dim key As Variant
    For Each key In dict.Keys
        inputString = Replace(inputString, "${" & key & "}", dict(key))
    Next key
    
    strFormat = inputString
End Function

メインコード

それでは、本題へ...
本コードは、makeFolderというサブルーチンが定義されており、フォルダ名のフォーマットに必要なデータを作成し、
指定されたExcelシートから物件名を取得し、指定されたフォーマットでフォルダを作成します。
また、フォルダの存在をチェックするために、checkFolderという関数が定義されています。

このコードは、Microsoft Scripting RuntimeライブラリのDictionaryオブジェクトを使用しているため、
Microsoft Scripting Runtimeライブラリをインポートする必要があります。
もしくは、Late Bindingを使用することもできます。

また、Win32APIのSleep関数を使用していますが、VBA7以降とそれ以前での宣言を分けています。

makeFolderの処理は、指定されたExcelシートから物件名を取得し、フォルダを作成します。
フォルダのフォーマットは、フォルダ名に年月日を付けたものになります。
フォルダの存在をチェックするために、checkFolder関数を使用しています。
フォルダのフォーマットと物件名から、フォルダ名を作成し、存在しない場合は作成します。

また、strFormat関数は、フォルダのフォーマットに必要なデータを含む辞書を受け取り、
指定された文字列の中の"${}"のパターンに合う箇所を辞書の中の値で置換することで、
フォルダ名のフォーマットを作成するために使用されています。

runサブルーチンは、アクティブなブックからmakeFolderを呼び出すために使用されます。
アクティブなブックがない場合は、エラーメッセージを表示します。

このコードは、指定されたフォルダ名のフォーマットに基づいてフォルダを作成するための一例であり、
実際の使用に合わせて変更する必要がある場合があります。

補足

今回のコードは、不動産関連の管理会社と調和性が高いコードに仕上げていますが、
コードを理解して、改変すればその他業種にでも、管理しやすいように作成されています。

使用例

'...
    String Format
    Dim strList As New Scripting.Dictionary
    Dim folderName As String
    '...日付を取得し、格納
    strList.add "y", Format(Year(Date), "0000")
    strList.add "m", Format(Month(Date), "00")
    strList.add "d", Format(Day(Date), "00")
    '...日付をフォーマットし、格納
    strList.add "strDate", strFormat("${y}${m}${d}", strList)
    strList.add "path", ThisWorkbook.Path
    '...
        '...物件名を取得して、存在する場合は、値を更新
            strList("property") = ACTSheet.Cells(i, "B").Value
        '...格納されたデータからフォルダー作成
        folderName = strFormat("${path}\${strDate}\${property}", strList)
        '...
'...

自作モジュールとコード

Module1 [標準モジュール(呼び出し用)]

Option Explicit
' Microsoft Scripting RuntimeライブラリのDictionaryオブジェクトを使用するために、下記のインポートを追加します。
' Late Bindingで使用する場合は必要ありません。
' "MS Scripting Runtime"と表示されることがあるので注意してください。
' Dim dict As Scripting.Dictionary
' Set dict = New Scripting.Dictionary

' インポートを使わない方法
' Late Binding
' Dim dict As Object
' Set dict = CreateObject("Scripting.Dictionary")

'Win32APIのSleep関数を宣言
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

Sub makeFolder(baseFile As Workbook)
    Dim ACTSheet As Worksheet
    Dim folderPath As String
    Dim folderName As String
    Dim strList As New Scripting.Dictionary
    Dim lastRow As Long, i As Long
    Set ACTSheet = baseFile.Worksheets("folder")
    strList.add "y", Format(Year(Date), "0000")
    strList.add "m", Format(Month(Date), "00")
    strList.add "d", Format(Day(Date), "00")
    
    strList.add "strDate", strFormat("${y}${m}${d}", strList)
    
    strList.add "path", ThisWorkbook.Path
    
    
    On Error Resume Next
        lastRow = ACTSheet.Cells(Rows.Count, "B").End(xlUp).Row
        folderPath = ThisWorkbook.Path ' ファイルのフォルダを取得
        checkFolder (strFormat("${path}\${strDate}", strList))
        
        For i = 1 To lastRow
            '物件名
            If strList.Exists("property") = True Then
                strList("property") = ACTSheet.Cells(i, "B").Value
            Else
                strList.add "property", ACTSheet.Cells(i, "B").Value
            End If
            
            'フォルダの確認と作成
            folderName = strFormat("${path}\${strDate}\${property}", strList)
            checkFolder (folderName)
        Next i
End Sub

Function checkFolder(cn As String) As Boolean
    If Dir(cn, vbDirectory) = "" Then
        MkDir cn
    End If
    checkFolder = True
End Function

Function strFormat(ByVal inputString As String, outputString As Variant) As String
    On Error Resume Next
    Dim regexPattern As String
    regexPattern = "\$\{.*?\}"
    
    Dim regex As New RegExp
    regex.Global = True
    regex.Pattern = regexPattern
    
    Dim dict As Object
    Set dict = JsonConverter.ParseJson(JsonConverter.ConvertToJson(outputString))

    Dim key As Variant
    For Each key In dict.Keys
        inputString = Replace(inputString, "${" & key & "}", dict(key))
    Next key
    
    strFormat = inputString
End Function

Excelのデータイメージ

該当のシートのマクロへ以下を追加して、実行する。
図形などにrunマクロを仕込むとボタン操作のようになり、GUI感覚で使いやすくなります。

なお、Excelが保存されているフォルダーの直下に作成されるため、
セキュリティの権限などにより作成できないことがあるかと思います。
ご注意ください。

Sheet1

Option Explicit

Sub run()
    Dim baseFile As Workbook
    On Error Resume Next
    Set baseFile = ActiveWorkbook
    On Error GoTo 0
    
    If baseFile Is Nothing Then
        MsgBox "アクティブなブックがありません。"
        Exit Sub
    End If
    Call makeFolder(baseFile)
    MsgBox "フォルダーの作成が完了しました。"
End Sub

以上が、VBAプログラマ向けのコード解析でした。
今回の解析が、VBAプログラミングの初学者や、
より高度なプログラマにとって有益な情報を提供できたことを願っています。
今後とも、技術ブログで役立つ情報を発信していく予定ですので、引き続きお楽しみにください。
ありがとうございました。