VBAでJSONをアクセス、ゆっくりムービーメーカー4の設定・エフェクトを一括変換

VBAでJSONをアクセス、ゆっくりムービーメーカー4の設定・エフェクトを一括変換してみました。
この動画のマクロはWindows11/Office2016で作成してます。

Sub sample1()
    'ゆっくりムービーメーカー4の定義ファイルymmpからセリフを読み出す
    
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    CurrentDirectory = ActiveWorkbook.Path
    
    Set Effect0 = New Dictionary	'「Microsoft Scripting Runtime」を参照設定
    Set Effect1 = New Dictionary
    
    Effect1.Add "From", 150
    Effect0.Add "$type", "YukkuriMovieMaker.Project.Effects.JumpEffect, YukkuriMovieMaker"
    Effect0.Add "Label", "跳ねる"
    Effect0.Add "JumpHeight", Effect1
    
    'ymmpファイルを読み込む
    Dim sr      As Object
    Dim strData As String
        strData = JsonConverter.ConvertToJson(Effect0)
    Set sr = CreateObject("ADODB.Stream")
    sr.Mode = 3 '読み取り/書き込みモード
    sr.Type = 2 'テキストデータ
    sr.Charset = "UTF-8" '文字コードを指定
    
    sr.Open 'Streamオブジェクトを開く
    sr.LoadFromFile (fso.BuildPath(CurrentDirectory, "test.ymmp"))
    sr.Position = 0 'ポインタを先頭へ
    strData = sr.ReadText() 'データ読み込み
    sr.Close 'Streamを閉じる
    
    'Debug.Print (strData)

    ' JSONパースサンプル
    Dim jsonObj As Object
    Set jsonObj = JsonConverter.ParseJson(strData)
    
    'セリフオブジェクトをクロールする
    For Each oItem In jsonObj("Timeline")("Items")
        If InStr(oItem("$type"), "VoiceItem") > 0 Then
            'VoiceoItem
            Debug.Print oItem("CharacterName") & "," & oItem("Serif")
        End If
    Next
    
    'オブジェクトの解放
    Set fso = Nothing
    Set sr = Nothing
End Sub



Sub sample2()
    'ゆっくりムービーメーカー4の定義ファイルymmpを書き換える
    
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    CurrentDirectory = ActiveWorkbook.Path
    
    Set Effect0 = New Dictionary	'「Microsoft Scripting Runtime」を参照設定
    Set Effect1 = New Dictionary
    
    Effect1.Add "From", 150
    Effect0.Add "$type", "YukkuriMovieMaker.Project.Effects.JumpEffect, YukkuriMovieMaker"
    Effect0.Add "Label", "跳ねる"
    Effect0.Add "JumpHeight", Effect1
    
    'ymmpファイルを読み込む
    Dim sr      As Object
    Dim strData As String
        strData = JsonConverter.ConvertToJson(Effect0)
    Set sr = CreateObject("ADODB.Stream")
    sr.Mode = 3 '読み取り/書き込みモード
    sr.Type = 2 'テキストデータ
    sr.Charset = "UTF-8" '文字コードを指定
    
    sr.Open 'Streamオブジェクトを開く
    sr.LoadFromFile (fso.BuildPath(CurrentDirectory, "test.ymmp"))
    sr.Position = 0 'ポインタを先頭へ
    strData = sr.ReadText() 'データ読み込み
    sr.Close 'Streamを閉じる
    
    'Debug.Print (strData)

    ' JSONパースサンプル
    Dim jsonObj As Object
    Set jsonObj = JsonConverter.ParseJson(strData)
    
    'セリフオブジェクトをクロールする
    For Each oItem In jsonObj("Timeline")("Items")
        If InStr(oItem("$type"), "VoiceItem") > 0 Then
            'VoiceoItem
            Debug.Print oItem("CharacterName") & "," & oItem("Serif")
            
            'セリフに「笑」があったらゆっくりの表情を変える
            If InStr(oItem("Serif"), "笑") > 0 Then
                oItem("TachieFaceParameter")("Eye") = Replace(oItem("TachieFaceParameter")("Eye"), "00.png", "06.png")
            End If
            
            'セリフに「はねて」があったら跳ねるエフェクトをつける
            If InStr(oItem("Serif"), "はねて") > 0 Then
                oItem("TachieFaceEffects").Add Effect0
            End If
            
            '魔理沙のレイヤーを4にする
            If InStr(oItem("CharacterName"), "魔理沙") > 0 Then
                oItem("Layer") = 4
            End If
        End If
    Next
    
    'ymmpファイルを書き込む
    '編集したjsonObjをテキスト形式に
    strData = JsonConverter.ConvertToJson(jsonObj)
    sr.Open 'Streamオブジェクトを開く
    sr.Position = 0 'ポインタを先頭へ
    sr.WriteText strData
    '上書き保存
    sr.SaveToFile fso.BuildPath(CurrentDirectory, "test_update.ymmp"), 2
    sr.Close 'Streamを閉じる
    
    'オブジェクトの解放
    Set fso = Nothing
    Set sr = Nothing
End Sub