'序数：47 Alias "#47" を付けても良い↓
Private Declare Function PathMakeUniqueName Lib "shell32" (ByVal pszUniqueName As Long, ByVal ccMax As Long, ByVal pszTemplate As String, ByVal pszLongPlate As Long, ByVal pszDir As Long) As Long

'序数：75 Alias "#75" を付けても良い↓
Private Declare Function PathYetAnotherMakeUniqueName Lib "shell32" (ByVal pszUniqueName As Long, ByVal pszPath As Long, ByVal pszShort As Long, ByVal pszFileSpec As Long) As Long

Private Const MAX_PATH = 260

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：一意のファイル名を生成する - その１
' 引  数：(i)hWnd      … ウィンドウハンドル
'         (i)FileNameL … 長いファイル名
'         (i)DirNameL  … 長いディレクトリ名
' 返り値：正常…一意のファイル名  異常…空文字
' 備  考：引数ファイル名の次のファイル名を生成する
'         引数 DirNameL が Test.txt で、引数 FileNameL が C:\ABC\ の場合、
'         C:\ABC\Test.txt が存在しなくても C:\ABC\Test (1).txt を返す
'         C:\ABC\Test (1).txt が存在する場合は C:\ABC\Test (2).txt を返す
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function GetUniqueName1(ByVal hWnd As Long, ByVal FileNameL As String, _
                               ByVal DirNameL As String) As String
    Dim FuncRet As Long
    Dim FileName As String

    '返り値変数初期化
    FileName = String$(MAX_PATH, Chr$(0))

    '一意のファイル名を生成する
    FuncRet = PathMakeUniqueName(StrPtr(FileName), MAX_PATH, 0&, StrPtr(FileNameL), StrPtr(DirNameL))
    If FuncRet Then
        GetUniqueName1 = StrNullCut(FileName)
    End If
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：一意のファイル名を生成する - その２
' 引  数：(i)hWnd      … ウィンドウハンドル
'         (i)FileNameL … 長いファイル名
'         (i)DirNameL  … 長いディレクトリ名
' 返り値：正常…一意のファイル名  異常…空文字
' 備  考：引数ファイルが存在する場合は次のファイル名を生成する
'         引数 DirNameL が Test.txt で、引数 FileNameL が C:\ABC\ の場合、
'         C:\ABC\Test.txt が存在しない場合は C:\ABC\Test.txt を返す
'         C:\ABC\Test.txt が存在する場合は C:\ABC\Test (2).txt を返す(※１)
'         C:\ABC\Test (2).txt が存在する場合は C:\ABC\Test (3).txt を返す
'         ※１…C:\ABC\Test (1).txt は返さない
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function GetUniqueName2(ByVal hWnd As Long, ByVal FileNameL As String, _
                               ByVal DirNameL As String) As String
    Dim FuncRet As Long
    Dim FileName As String

    '第３引数 DirNameL の後尾は "\" である必要があるので、無ければ補う
    '"\"が後尾に無い場合は PathYetAnotherMakeUniqueName の第２引数が無視される模様
    'なお上記 GetUniqueName1 関数ではこの処理は不要(API使用にバラツキあるねぇ)
    If Right$(DirNameL, 1) <> "\" Then DirNameL = DirNameL & "\"

    '返り値変数初期化
    FileName = String$(MAX_PATH, Chr$(0))

    '一意のファイル名を生成する
    FuncRet = PathYetAnotherMakeUniqueName(StrPtr(FileName), StrPtr(DirNameL), 0&, StrPtr(FileNameL))
    If FuncRet Then
        GetUniqueName2 = StrNullCut(FileName)
    End If
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：文字列を Chr$(0)[=vbNullChar] まで取得する
' 引  数：(in)SrcStr … 対象文字列
' 返り値：編集された文字列
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Private Function StrNullCut(ByVal SrcStr As String) As String
    Dim NullCharPos As Long
    NullCharPos = InStr(SrcStr, Chr$(0))
    If NullCharPos = 0 Then
        StrNullCut = SrcStr
        Exit Function
    End If
    StrNullCut = Left$(SrcStr, NullCharPos - 1)
End Function