えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

VBAで相対パスから絶対パスへ変換する高速な汎用関数をつくってみた

本記事では、VBA相対パスから絶対パスへ変換する関数を作成するために

  1. 相対パス絶対パスについて

  2. FileSystemObjectを使った変換方法

  3. fso.GetAbsolutePathNameとfso.BuildPathの問題点

  4. 汎用性が高くて高速な自作関数

について解説する。


相対パス絶対パスについて

そもそも相対パス絶対パスとは何か。

読者の方にとってはいまさらかもしれないが、重要なことなので基本的なことだけ書いておく。

パス 意味
.\Book1.xlsx 同一のフォルダのBook1.xlsxを示す。
..\Book1.xlsx 一つ上のフォルダのBook1.xlsxを示す。

以上。


え、説明が足りない?

では、C:\hoge\fuga\test.xlsmというエクセルでコーディングするとしよう。

このときのカレントディレクトリをC:\hoge\fuga\と仮定するとこうなる。

相対パス 絶対パス
.\Book1.xlsx C:\hoge\fuga\Book1.xlsx
..\Book1.xlsx C:\hoge\Book1.xlsx

これ以上の詳しい説明はWikipediaに任せる。

ちなみにVBAではパスの区切り文字については、¥や/のどちらを使っても正常に動くが、一応本記事ではWindowsユーザーの見慣れた\で説明する。


FileSystemObjectを使った変換方法

それでは次に、相対パスから絶対パスを求める超簡単な関数を紹介しよう。

コード

この関数ではFileSystemObjectを使っているのでMicrosoft Scripting Runtimeの参照設定をお忘れなく。

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

大したことはしていないので、もともとfsoを使っているコードなら関数化する必要はないと思われる。

VBE上で確認するためのテストコードを書くならこんな感じだろうか。

Sub GetAbsolutePathNameExFso_Test()
    Const RefPath = "..\Book1.xlsx"

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

この関数を使って以下の様なパターンを検証して表にまとめるとこのようになる。

basePath refPath 実行結果
C:\hoge\fuga\ Book1.xlsx C:\hoge\fuga\Book1.xlsx
C:\hoge\fuga Book1.xlsx C:\hoge\fuga\Book1.xlsx
C:\hoge\fuga\ \Book1.xlsx C:\hoge\fuga\Book1.xlsx
C:\hoge\fuga\ .\Book1.xlsx C:\hoge\fuga\Book1.xlsx
C:\hoge\fuga\ ..\Book1.xlsx C:\hoge\Book1.xlsx
C:\hoge\fuga ..\Book1.xlsx C:\hoge\Book1.xlsx

いずれも動作に問題はなさそうだ。

実はこの表を作るにあたって、実行結果の列に=GetAbsolutePathNameExFso(A2,B2)と入力して作成しているが、詳しくは後の記事にて紹介しようと思う。

www.excel-chunchun.com

解説

まずBuildPathだが、要するに2つのパスをくっ付けるだけの関数だ。

Microsoftのサイトではpathとnameという名前を用いているが、nameの部分はファイル名とは限らないので本記事ではbasePathとrefPathという書き方をさせてもらう。

basePath refPath 実行結果 問題点
C:\hoge\fuga\ Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga\ \Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga\ .\Book1.xlsx C:\hoge\fuga\.\Book1.xlsx .\が残る
C:\hoge\fuga\ ..\Book1.xlsx C:\hoge\fuga\..\Book1.xlsx ..\が残る
C:\hoge\fuga ..\Book1.xlsx C:\hoge\fuga\..\Book1.xlsx ..\が残る

このように、前半のパスと後半のパスの間の\記号をうまいこと補完してくれるが、相対パスの.\や..\は解釈されずに結合される。

次にGetAbsolutePathNameだが、まずはBuildPathを使わずにfso.GetAbsolutePathName(basePath & refPath)を実行した場合を見てみよう。

basePath refPath 実行結果 問題点
C:\hoge\fuga\ Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga Book1.xlsx C:\hoge\fugaBook1.xlsx \が足りない
C:\hoge\fuga\ \Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga\ .\Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga\ ..\Book1.xlsx C:\hoge\Book1.xlsx OK
C:\hoge\fuga ..\Book1.xlsx C:\hoge\fuga..\Book1.xlsx ..\が残る

このようにbasePathの末尾に\が不足していると、GetAbsolutePathNameは正しく解釈出来ない場合があるのでBuildPathとセットで使うほうが良い。

ついでに、BuildPathを使わずにfso.GetAbsolutePathName(basePath & "\" & refPath)としたらどうなるのか気になったので試してみた。

basePath refPath 実行結果 問題点
C:\hoge\fuga\ Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga\ \Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga\ .\Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga\ ..\Book1.xlsx C:\hoge\Book1.xlsx OK
C:\hoge\fuga ..\Book1.xlsx C:\hoge\Book1.xlsx OK

なんと\\は\として処理されており、晴れてBuildPathはいらない子となったのであった。

とは言え、これ以外のパターンで問題が起こるのかもしれないし素直にBuildPathを使ったほうが無難かもしれない。

fso.GetAbsolutePathNameとfso.BuildPathの問題点

ここまで長々と解説してきたが、本題はここからだ。

上記関数には致命的な問題点がある。

それは、

UNCパスに対応しきれていない。

という点だ。

UNCパスというのは、つまりはファイルサーバー上とかのネットワークフォルダを示すパスのことである。

ここからはC:\hogeさんにはお帰りいただいて\\127.0.0.1の登場だ。

上記の表を置き換えるとこうなる。

basePath refPath 実行結果 問題点
\\127.0.0.1\fuga\ Book1.xlsx \\127.0.0.1\fuga\Book1.xlsx OK
\\127.0.0.1\fuga Book1.xlsx \\127.0.0.1\fuga\Book1.xlsx OK
\\127.0.0.1\fuga\ \Book1.xlsx \\127.0.0.1\fuga\Book1.xlsx OK
\\127.0.0.1\fuga\ .\Book1.xlsx \\127.0.0.1\fuga\Book1.xlsx OK
\\127.0.0.1\fuga\ ..\Book1.xlsx \\127.0.0.1\fuga\Book1.xlsx ..\が無視される
\\127.0.0.1\fuga ..\Book1.xlsx \\127.0.0.1\fuga\Book1.xlsx ..\が無視される

どうやらGetAbsolutePathNameはネットワークコンピュータ直下には移動出来ない仕様らしいことがわかった。

とはいえ、一般的な運用でネットワークフォルダを横断するような事はまず無いと思う。

さらにもう一つ厄介なことがわかった。

存在しないサーバーのUNCパスは解析に時間がかかる

という点だ。

この例では127.0.0.1ループバックアドレス=自身(実行中のPC)を示すアドレス)を指定しているため問題ないが、ネットワークに存在しないコンピュータを指定すると、1コール10秒程度の規模でExcelが応答なしになる。

VBAプロセス外の応答待ちなのでESCを押しても、まず中断できることはない。

大量処理のループ中に発生しようものなら発狂は必至である。

そうでなくても、連続でGetAbsolutePathNameを呼び出すと、かなりの処理時間を要することが分かった。

こちらも一般的な運用で障害となる事はあまり無いと思う。


以上がFileSystemObjecttのGetAbsolutePathNameの問題である。

汎用性があって高速な自作関数

非常識な環境でパスの解析を行いたい私は、上記の問題点は見過ごす事ができない。

こうなったら自作するしか無い。

ついでにFileSystemObjectを不要にしてしまえ。

というわけで、次のような関数を自作した。

面倒なのでコードの細かい解説は行わない。動けばいいのだよ、動けば。

コード

'フォルダの絶対パスとファイルの相対パスを合成して、目的のファイルの絶対パスを取得する関数
'fso.GetAbsolutePathName(fso.BuildPath(basePath, refPath))を汎用化した関数
Function GetAbsolutePathNameEx(ByVal basePath As String, ByVal RefPath As String) As String
    Dim i As Long
    
    basePath = Replace(basePath, "/", "\")
    basePath = Left(basePath, Len(basePath) - IIf(Right(basePath, 1) = "\", 1, 0))
    
    RefPath = Replace(RefPath, "/", "\")
    
    Dim retVal As String
    Dim rpArr() As String
    rpArr = Split(RefPath, "\")
    
    For i = LBound(rpArr) To UBound(rpArr)
        Select Case rpArr(i)
            Case "", "."
                If retVal = "" Then retVal = basePath
                rpArr(i) = ""
            Case ".."
                If retVal = "" Then retVal = basePath
                If InStrRev(retVal, "\") = 0 Then
                    Err.Raise 8888, "GetAbsolutePathNameEx", "到達できないパスを指定しています。"
                    GetAbsolutePathNameEx = ""
                Exit Function
            End If
                retVal = Left(retVal, InStrRev(retVal, "\") - 1)
                rpArr(i) = ""
            Case Else
                retVal = retVal & IIf(retVal = "", "", "\") & rpArr(i)
                rpArr(i) = ""
        End Select
        '相対パス部分が空欄、.\、..\で終わった時、末尾の\が不足するので補完が必要
        If i = UBound(rpArr) Then
            If RefPath <> "" Then
                If Right(RefPath, 1) = "\" Then
                    retVal = retVal & "\"
                End If
            End If
        End If
    Next
    '連続\の消去とネットワークパス対策
    retVal = Replace(retVal, "\\", "\")
    retVal = IIf(Left(retVal, 1) = "\", "\", "") & retVal
    GetAbsolutePathNameEx = retVal
End Function

テストパターン例

しかし使う時にそれでは困ると思うので、テストパターンとfsoを使った場合と私の関数を使った場合の比較表を書いておく。

basePath refPath FileSystemObject 自作関数 差異
C:\hoge\fuga\ .\Book1.xlsx C:\hoge\fuga\Book1.xlsx C:\hoge\fuga\Book1.xlsx OK
C:\hoge\fuga\ ..\Book1.xlsx C:\hoge\Book1.xlsx C:\hoge\Book1.xlsx OK
C:\hoge\fuga\ ..\..\Book1xlsx C:\Book1xlsx C:\Book1xlsx OK
C:\hoge\fuga\ ..\piyo\Book1.xlsx C:\hoge\piyo\Book1.xlsx C:\hoge\piyo\Book1.xlsx OK
\\hoge\fuga\ ..\piyo\Book1.xlsx \\hoge\fuga\piyo\Book1.xlsx \\hoge\piyo\Book1.xlsx UNCに対応
\\127.0.0.1\hoge\fuga\ ..\..\Book1.xlsx \\127.0.0.1\hoge\Book1.xlsx \\127.0.0.1\Book1.xlsx UNCに対応
C:\hoge\ ..\..\Book1.xlsx C:\Book1.xlsx #VALUE! 到達不能はエラー
C:\hoge\ ..\.\Book1.xlsx C:\Book1.xlsx C:\Book1.xlsx OK
C:\hoge\ \Book1.xlsx C:\hoge\Book1.xlsx C:\hoge\Book1.xlsx OK
C:\hoge\ C:\Book1.xlsx C:\hoge\C:\Book1.xlsx C:\Book1.xlsx refPathが絶対パスのときはrefPathで上書き
C:\hoge\ .\Book1 C:\hoge\Book1 C:\hoge\Book1 OK ※拡張子無しファイル
C:\hoge\ .\ C:\hoge C:\hoge\ refPathがディレクトリのときは末尾に\を追記
C:\hoge\ C:\hoge refPathが空欄のときは空欄を返す
C:\hoge\ .\fuga\piyo\..\Book1.xlsx C:\hoge\fuga\Book1.xlsx C:\hoge\fuga\Book1.xlsx OK ※相対パス途中に..\が存在する例

ちなみにディレクトリを返す時に末尾に\をつけて終了させているのには理由があって、Windowsでは「拡張子のないファイル」も存在し得るので、末尾に\が無いとフォルダなのかファイルなのか判別出来ないからである。(GetAtter等の関数で属性を読み取れば判別はできます)

ThisWorkbook.Pathにしても、GetAbsolutePathNameにしても何故末尾に\を付けて返してくれないのか理解に苦しむ。(※個人の感想です)

おわりに

これで、相対パス絶対パスの変換がとてもやりやすくなった。

今後はfsoに頼るのは止めて、自作関数を使っていきたい。

以上


何か御座いましたらコメント欄、またはTwitterからどうぞ♪

週1回の更新を目指して、頑張ってますので応援よろしくおねがいします!

それでは、また来週♪ ちゅんちゅん(・8・)