同一UUIDのDraw参照元ファイルを差し替える3

こちらの続きです。
同一UUIDのDraw参照元ファイルを差し替える2 - C#ATIA

レーベンシュタイン距離を利用して二つのフォルダ内のファイル郡を
類似したファイル名同士の組み合わせリストを作ります。
（日本語がおかしいかも）

'vba CreateReplaceComb ver0.0.1  using-'KCL0.0.12'  by Kantoku
'ReplaceDrawLink用の組合せﾘｽﾄ作成

Option Explicit

'**API***
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
        (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
        
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
    (lpBrowseInfo As BROWSEINFO) As LongPtr
Private Type BROWSEINFO
    hOwner As LongPtr
    pidlRoot As LongPtr
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As LongPtr
    lParam As LongPtr
    iImage As Long
End Type

Private Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As LongPtr
'***********

Private Const DELIMTER_COMB = "|"
Private Const EXP_EXTENSION = "comb"
Private Const SELECTIONTYPE = "*." & EXP_EXTENSION

Private Const PART_EXTENSION = "CATPart"
Private Const DRAW_EXTENSION = "CATDrawing"

Private Const MIN_RATIO = 10

Sub CATMain()
    Dim msg As String
    
    'Part側
    msg = "参照元となるPartが入ったﾌｫﾙﾀﾞを指定してください"
    Dim pt_path As String
    pt_path = SelectFolder(msg)
    If pt_path = vbNullString Then Exit Sub
    
    'Draw側
    msg = "参考のDrawが入ったﾌｫﾙﾀﾞを指定してください"
    Dim dw_path As String
    dw_path = SelectFolder(msg)
    If dw_path = vbNullString Then Exit Sub
    
    '確認
    msg = "参照元 : " & pt_path & vbCrLf & _
        "参　考 : " & dw_path & vbCrLf & _
        "を元に組合せﾌｧｲﾙを作成します" & vbCrLf & _
        "宜しいですか?"
    If MsgBox(msg, vbYesNo + vbQuestion) = vbNo Then Exit Sub
    
    'Part側
    Dim pt_dic As Object
    Set pt_dic = GetFilesDic(pt_path, PART_EXTENSION)
    If pt_dic.Count < 1 Then
        MsgBox "拡張子 [ " & PART_EXTENSION & " ] のﾌｧｲﾙが見つかりませんでした"
        Exit Sub
    End If
    
    'Draw側
    Dim dw_dic As Object
    Set dw_dic = GetFilesDic(dw_path, DRAW_EXTENSION)
    If dw_dic.Count < 1 Then
        MsgBox "拡張子 [ " & DRAW_EXTENSION & " ] のﾌｧｲﾙが見つかりませんでした"
        Exit Sub
    End If
    
    '組合せ
    Dim comb As Object
    Set comb = GetCombin(pt_dic, dw_dic)
    If comb.Count < 1 Then
        MsgBox "ファイル名の類似した組合せが見つかりませんでした"
        Exit Sub
    End If
    
    'ｴｸｽﾎﾟｰﾄ
    Dim exp_path As String
    exp_path = GetExportFilePath("組合せ保存")
    If exp_path = vbNullString Then Exit Sub
    
    Call KCL.WriteFile(exp_path, Join(comb.toArray(), vbCrLf))
    
    '表示
    Call shell("notepad.exe " & exp_path, vbNormalFocus)
    
End Sub

'ｴｸｽﾎﾟｰﾄﾌｧｲﾙﾊﾟｽ
Private Function GetExportFilePath( _
    ByVal msg As String)
    
    GetExportFilePath = vbNullString
    
    Dim fso As Object
    Set fso = KCL.GetFSO
    
    Dim exp_path As String
    Dim msg2 As String
    Do
        exp_path = CATIA.FileSelectionBox( _
            msg, _
            SELECTIONTYPE, _
            CatFileSelectionModeSave)
        If exp_path = vbNullString Then Exit Function
        
        If fso.GetExtensionName(exp_path) = "" Then
            exp_path = exp_path & "." & EXP_EXTENSION
        End If
        
        If KCL.IsExists(exp_path) Then
            msg2 = "[" & fso.GetFile(exp_path).Name & "]" & vbCrLf & _
                "は存在します。上書きしますか?"
            If MsgBox(msg2, vbYesNo + vbQuestion) = vbYes Then
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
    
    GetExportFilePath = exp_path
End Function

'組み合わせ
'MIN_RATIO以下は相手無しとする
Private Function GetCombin( _
    ByVal pt_dic As Object, _
    ByVal dw_dic As Object)
    
    Dim comb As Object
    Set comb = KCL.InitLst()
    
    Dim p As Variant, d As Variant, stock As String
    Dim ratio As Long, max_ra As Long
    For Each p In pt_dic.keys
        max_ra = 0
        stock = ""
        For Each d In dw_dic
            ratio = Levenshtein(p, d)
            If max_ra < ratio Then
                max_ra = ratio
                stock = d
            End If
        Next
        If ratio > MIN_RATIO Then
            comb.Add pt_dic(p) & DELIMTER_COMB & dw_dic(stock)
        Else
            comb.Add pt_dic(p) & DELIMTER_COMB & ""
        End If
    Next
    Set GetCombin = comb
End Function

'指定ﾌｫﾙﾀﾞﾊﾟｽ内の指定拡張子ﾌｧｲﾙ辞書
Private Function GetFilesDic( _
    ByVal path As String, _
    Optional ByVal ext = "") As Object
    
    Dim fso As Object
    Set fso = KCL.GetFSO
    
    Dim dic As Object
    Set dic = KCL.InitDic
    
    Dim f As Object
    For Each f In fso.GetFolder(path).files
        If Len(ext) < 1 Then
            dic.Add fso.GetBaseName(f), f
        ElseIf LCase(ext) = LCase(fso.GetExtensionName(f)) Then
            dic.Add fso.GetBaseName(f), f
        End If
    Next
    Set GetFilesDic = dic
End Function

'ﾌｫﾙﾀﾞ選択
Private Function SelectFolder( _
    Optional msg As String) As String
    
    Dim bInfo As BROWSEINFO
    bInfo.pidlRoot = 0&
    If IsMissing(msg) Then
        bInfo.lpszTitle = "フォルダの選択..."
    Else
        bInfo.lpszTitle = msg
    End If
    bInfo.ulFlags = &H1
    
    Dim X As LongPtr
    X = SHBrowseForFolder(bInfo)
    
    Dim pPath As String
    pPath = Space$(512)
    
    Dim R As Boolean
    R = SHGetPathFromIDList(ByVal X, ByVal pPath)
    
    Dim pos As Integer
    If R Then
        pos = InStr(pPath, Chr$(0))
        SelectFolder = Left(pPath, pos - 1)
    Else
        SelectFolder = vbNullString
    End If
End Function

CATPartの入ったフォルダとCATDrawingの入ったフォルダを指定し、
リンク元を差し替える為の組合せをリスト化したファイルを作ります。
（この表現でもわかりにくい）
このマクロ自体は通過点です。内容的にはCATIAとは無関係なのですが、
Excelでの利用とか全く考えてません。

最初はCSVファイルを作成するつもりだったのですが、CSVの一般的な
区切り文字「，」がファイル名として許されます。
今の所「，」を使われたファイル名が手元に無いのですが、将来的に
”ファイル名に使われない”　と言う保障が無い為（と、言うより
利用される気がしてならない）ファイル名として許されない文字を
区切り文字としてみました。
･･･今時だったらJSONが良いのかなぁ