VBAで相対パスから絶対パスに変換する関数

感想

VBAで相対パスから絶対パスに変換する関数を頑張って作ったら、検索して出てきたのでガッカリした。

自分が作った関数

Function 相対パスを絶対パスに変更する(ByVal FilePath As String) As String
    Dim FilePathLeft As String
    FilePath = Replace(FilePath, "/", "\")
    FilePathLeft = ThisWorkbook.path
    Do
        If Left(FilePath, 2) <> ".." Then
            Exit Do
        End If

        FilePath = Mid(FilePath, InStr(FilePath, "\") + 1)
        FilePathLeft = Mid(FilePathLeft, 1, InStrRev(FilePathLeft, "\") - 1)
    Loop
    
    If Left(FilePath, 2) = ".\" Then
        '「.\」を削除する
        FilePath = Mid(FilePath, InStr(FilePath, "\") + 1)
    End If
    
    FilePath = FilePathLeft & "\" & FilePath
    
    If ファイルが存在するかどうか(FilePath) = False Then
        'ファイルが存在しない場合
        MsgBox "「" & FilePath & "」というファイルは存在しません。" & vbNewLine & "終了します。"
        End
    End If
    相対パスを絶対パスに変更する = FilePath
End Function

' 参照設定でMicrosoft Scripting Runtimeの利用が必要
Function ファイルが存在するかどうか(ByVal FilePath As String) As Boolean
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject ' インスタンス化
    ファイルが存在するかどうか = fso.FileExists(FilePath) ' ファイルの存在確認
    Set fso = Nothing
End Function

'呼び出し元の関数
Sub Test()
    Dim FilePath As String
    FilePath = "../../出力ファイル/お客様.xlsx"
    MsgBox 相対パスを絶対パスに変更する(FilePath)
End Sub

Web上にすでに公開されていた関数

引用元：https://www.excel-chunchun.com/entry/2018/12/30/121243

Function GetAbsolutePathNameExFso(ByVal basePath As String, ByVal RefPath As String) As String
     Dim fso As FileSystemObject
     Set fso = New FileSystemObject
     GetAbsolutePathNameExFso = fso.GetAbsolutePathName(fso.BuildPath(basePath, RefPath))
End Function

'呼び出し元の関数
Sub GetAbsolutePathNameExFso_Test()
    Const RefPath = "..\Book1.xlsx"

    MsgBox "ルート　：" & ThisWorkbook.Path & vbLf & _
    "相対パス：" & RefPath & vbLf & _
    "絶対パス：" & GetAbsolutePathNameExFso(ThisWorkbook.Path, RefPath)
End Sub

感想

まあ、こんなこともあります。

追記）エラー

引数に絶対パスを入れると想定外の文字列になりますので、
エラーになることを確認しています。