スポンサーリンク

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

2021年5月2日

概要

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のコードはネコギシ様に動作確認して頂きました。

コード

'[VBA]OneDriveで同期しているファイルまたはフォルダのURLをローカルパスに変換する関数
'Copyright (c) 2020 黒い箱の中 All Rights Reserved.
'This software is released under the GPLv3<https://opensource.org/licenses/GPL-3.0>.
'このソフトウェアはGNU GPLv3の下でリリースされています<https://opensource.org/licenses/GPL-3.0>。;

'* @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, "/")

        If (FilePathPos = 0) Then
            OneDriveUrlToLocalPath = OneDriveConsumerPath
        Else
            OneDriveUrlToLocalPath = OneDriveConsumerPath & Replace(Mid(Url, FilePathPos), "/", PathSeparator)
        End If
    End If

End Function

プログラムの利用について

本プログラムのライセンスは「GPL-3.0(GNU General Public License version 3)」を適用しています。

本プログラムを私的に利用(個人利用、並びに企業またはその他の組織の内部利用)される方は、本プログラムを無償で利用できると考えて差し支え御座いません。その場合でも、本プログラム内の著作権及びライセンスの表示は削除せずに表示しておいて下さい。

その他の方は、GNU 一般公衆利用許諾書（GNU GENERAL PUBLIC LICENSE）バージョン3の内容をご理解頂き、適正な利用をお願い致します。同ライセンス以外での利用をご希望の方はお問い合わせフォームよりご連絡下さい。

本ホームページのプログラムを書籍またはホームページ等で一般公開したい方は、お問い合わせフォームよりご連絡下さい。

スポンサーリンク

VBAGPLv3

Posted by 黒箱