[VBA]OneDriveで同期しているファイルまたはフォルダのURLをローカルパスに変換する関数

2020年6月7日

概要

Excel VBAのThisWorkbook.FullNameやThisWorkbook.Pathなどで絶対パスを取得する際、ExcelファイルがOneDriveに保存している場合、これらのメソッドはパスではなくURLを返すことがあります。例えば、"test.xlsm"というExcelファイルをCドライブ直下に保存した状態で、VBAからThisWorkbook.PathまたはThisWorkbook.FullNameを呼び出した場合、戻り値は"C:\test.xlsm"となります。しかし、ExcelファイルがOneDriveと同期している(OneDrive内のフォルダに保存している)場合、ThisWorkbook.Path及びThisWorkbook.FullNameはURLを返します。特に、個人向けOneDriveを使用している場合は"https://d.docs.live.net/CID番号/フォルダパス/test.xlsm"というURLが返ってきます。

この現象はExcelに限らず、WordにおけるThisDocument及びApplication.Documents、並びにPowerPointのApplication.PresentationsのPath及びFullNameでも発生します。この問題の根本的な解決法は(2020年04月29日時点で私が調べた限り)ありません。この問題は、OneDriveの使用を中止するか、OneDriveの設定を変更することでも対処可能ですが、マクロ開発者以外がマクロを使用する場合、現実的な対処法ではありません。

そこで、このURLをローカルパスに変換する関数を作成しました。なお、法人向けのOneDrive for Businessを使用していないので、OneDrive for Business向けのコードはテストしていません。動作報告をして下さる方をお待ちしております。OneDrive for Businessのコードはネコギシ様に動作確認して頂きました。

コード

'* @fn Public Function OneDriveUrlToLocalPath(ByRef Url As String) As String
'* @brief OneDriveのファイルURL又はフォルダURLをローカルパスに変換します。
'* @param[in] Url OneDrive内に保存されたのファイル又はフォルダのURL
'* @return Variant ローカルパスを返します。引数Urlにローカルパスに"https://"以外から始まる文字列を指定した場合、引数Urlを返します。
'* @details OneDriveのファイルURL又はフォルダURLをローカルパスに変換します。本関数は、ExcelブックがOneDrive内に格納されている場合に、Workbook.Path又はWorkbook.FullNameがURLを返す問題を解決するためのものです。
'*
Public Function OneDriveUrlToLocalPath(ByRef Url As String) As String
Const OneDriveCommercialUrlPattern As String = "*my.sharepoint.com*" '法人向けOneDriveのURLか否かを判定するためのLike右辺値
    '引数がURLでない場合、引数はローカルパスと判断してそのまま返す。
    If Not (Url Like "https://*") Then
        OneDriveUrlToLocalPath = Url
        Exit Function
    End If
    
    'OneDriveのパスを取得しておく(パフォーマンス優先)。
    Static PathSeparator As String
    Static OneDriveCommercialPath As String
    Static OneDriveConsumerPath As String
    
    If (PathSeparator = "") Then
        PathSeparator = Application.PathSeparator
        
        '法人向けOneDrive(OneDrive for Business)のパス
        OneDriveCommercialPath = Environ("OneDriveCommercial")
        If (OneDriveCommercialPath = "") Then OneDriveCommercialPath = Environ("OneDrive")
        
        '個人向けOneDriveのパス
        OneDriveConsumerPath = Environ("OneDriveConsumer")
        If (OneDriveConsumerPath = "") Then OneDriveConsumerPath = Environ("OneDrive")
    End If
    
    '法人向けOneDrive：URL＝"https://会社名-my.sharepoint.com/personal/ユーザー名_domain_com/Documentsファイルパス")
    Dim FilePathPos As Long
    If (Url Like OneDriveCommercialUrlPattern) Then
        FilePathPos = InStr(1, Url, "/Documents") + 10 '10 = Len("/Documents")
        OneDriveUrlToLocalPath = OneDriveCommercialPath & Replace(Mid(Url, FilePathPos), "/", PathSeparator)
        
    '個人向けOneDrive：URL＝"https://d.docs.live.net/CID番号/ファイルパス"
    Else
        FilePathPos = InStr(9, Url, "/") '9 == Len("https://") + 1
        FilePathPos = InStr(FilePathPos + 1, Url, "/")
        OneDriveUrlToLocalPath = OneDriveConsumerPath & Replace(Mid(Url, FilePathPos), "/", PathSeparator)
    
    End If
End Function

ソースコードの利用について

本ソースコードは「GPL v3.0(GNU General Public License Version 3.0)」ライセンスで利用可能です。

本ソースコードを私的に利用される方は、本ソースコードが無料で利用できると考えて差し支え御座いません。下記の著作権表示をソースコード内に表示して頂ければ幸いです。

Copyright © 2017 黒い箱の中 All Rights Reserved.(https://kuroihako.com/)

本ホームページのソースコードを利用したソフトウェアを商用利用したり、ホームページ等で一般公開する方は、本ホームページのソフトウェアまたはソースコードに適用されているライセンスをご理解頂いてからご使用ください。同ライセンス以外での利用をご希望の方はお問い合わせフォームよりご連絡下さい。

VBAソースコード

Posted by 黒箱