[VBA]OneDriveで同期しているファイルまたはフォルダのURLをローカルパスに変換する関数
概要
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, "/")
OneDriveUrlToLocalPath = OneDriveConsumerPath & Replace(Mid(Url, FilePathPos), "/", PathSeparator)
End If
End Function
プログラムの利用について
本プログラムのライセンスは「GPL-3.0(GNU General Public License version 3)」を適用しています。
本プログラムを私的に利用(個人利用、並びに企業またはその他の組織の内部利用)される方は、本プログラムを無償で利用できると考えて差し支え御座いません。その場合でも、本プログラム内の著作権及びライセンスの表示は削除せずに表示しておいて下さい。
その他の方は、GNU 一般公衆利用許諾書(GNU GENERAL PUBLIC LICENSE)バージョン3の内容をご理解頂き、適正な利用をお願い致します。同ライセンス以外での利用をご希望の方はお問い合わせフォームよりご連絡下さい。
本ホームページのプログラムを書籍またはホームページ等で一般公開したい方は、お問い合わせフォームよりご連絡下さい。
ディスカッション
コメント一覧
初めてコメントさせて頂きます。
ネコギシと申します。
勤務先の社内のみで使用するVBAマクロを作成中、
OneDrive上での動作確認をしていたところ、
OneDrive上の実行ファイルのフォルダ名が読み込めずに調べていて、
本ページにたどり着きました。
勝手ながら、黒箱さんのコードを使用して動作確認させて頂いたところ、
OneDrive for Bussessでもローカルパスに変更することが出来ました。
御礼と動作報告までにコメントを残させて頂きます。
有難うございました!
初めまして、黒箱です。
OneDrive for Bussessでの動作確認、誠にありがとうございました。大変助かります。
社内利用は歓迎致します。お役に立てたようでなによりです。
まつーらと申します。
エクセルで個人的な資料のデータベースを作成しており、CELL関数でフォルダのパスを取得して、
ハイパーリンクでPDF等のファイルを開くようにしていたのですが、
ONEDRIVEに移してからURLの取得となり、ブラウザが立ち上がるようになり困っておりました。
ネットで調べるも長いこと解決策が見つからなかったのですが、黒箱さんのページにたどり着き
ようやく解決しました。
素晴らしいコードをありがとうございました。
御礼と動作報告までにコメントを残させて頂きます。
初めまして、黒箱です。
動作確認のご報告、誠にありがとうございました。
CELL関数のパスもURLになることは知りませんでした。
情報提供ありがとうございました。