Excel VBA「ThisWorkbook.Path」でエラーを回避する方法
ディスクトップやドキュメントフォルダがOneDrive と同期が取られるようになってから、タイトルにあるようにVBAでカレントフォルダを指定すると「パスが見つかりません。」と表示されエラーが発生するようになりました。 原因は今まで下記のように返されていたパスが、ＵＲＬで返されるようになったためです。
ThisWorkbook.Path = “C:\Users\・・・・・・・・
↓
ThisWorkbook.Path = “https://domain-my.sharepoint.com/・・・・・・・・
今まで問題なく動作していたマクロが急に動かなくなりますので、利用者から問合せが多く寄せられることも想定されます。今回は「ThisWorkbook.Path」で発生するエラーの対処方法についてご紹介します。
※次のようなケースでも同様にエラーが発生します。
With ActiveWorkbook
xPath = .Path & “\" 'ファイルが置いてあるフォルダからのパスを指定
End With
対処方法その１
ディスクトップ右下にある OneDrive のマークを右クリックします。
「設定」メニューが表示されますので選択します。
「Office」のタブを選択し、
「Officeアプリケーションを使用して、開いているOfficeファイルを同期する」のレ点マークを外します。
右側の画面が表示された場合は、「詳細設定」の中の「ファイルのコラボレーション」を「オフ」にします。
以上の設定で、「ChDir ThisWorkbook.Path」 は問題なく動作するようになります。
対処方法その２
ＵＲＬをローカルパスに変換する関数を作成しましたので、下記サンプルコードを参考にご利用ください。
なお、最低限の動作確認はしておりますが、利用環境によっては動作しない場合も想定されますので事前に動作の確認を行った上でご利用ください。
利用にあたっては下記のOneDriveの環境変数を使ってＵＲＬからローカルパスを作成して返すようにします。
「OneDriveConsumer」「OneDriveCommercial」「OneDrive」
・Environ(“OneDriveConsumer") → “C:\Users\name\SkyDrive"
・Environ(“OneDriveCommercial") → “C:\Users\UserId\OneDrive – 〇〇株式会社"
・Environ(“OneDrive") → 個人PC又は会社PCによって上記のいずれかが返されます。
今回は 「OneDrive」 環境変数を使って ＵＲＬをローカルパスに変換します。
サンプルコードの処理内容 コードの作成手順はこちら
下記赤枠の「カレントフォルダ指定エラー回避」ボタンをクリックするとファイル選択のダイアログボックスが表示されます。エラー回避されていな場合は「パスが見つかりません。」という冒頭で紹介したエラーメッセージが表示されます。
サンプルコード1
「UrlToLocal」 が ＵＲＬをローカルパスに変換する関数ですが、
仕様が変わったためか、「サンプルコード1」でエラーが解消されない場合が出てきました。
その場合は次項の「サンプルコード2」で試してみて下さい。ローカルパス作成箇所を変えています。
Option Explicit '変数の宣言を強制する
Sub エラー回避()
'ファイルがあるカレントドライブを指定（関数「UrlToLocal」を使用）
ChDir UrlToLocal(ThisWorkbook.Path)
'カレントドライブのフォルダを開く
Dim varFileName As Variant
varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
Title:="CSVファイルの選択")
'キャンセルボタンを選択した場合
If varFileName = False Then
Exit Sub
End If
End Sub
'--------以下「UrlToLocal」関数の記述--------------
Public Function UrlToLocal(ByRef Url As String) As String
'OneDrive環境変数を格納する変数の定義
Dim OneDrive As String
'OneDrive環境変数の取得
OneDrive = Environ("OneDrive")
'「https://･･･････/Documents」までの文字数を格納する変数の定義
Dim CharPosi As String
' ＵＲＬからローカルパスを作成する
If Url Like "https://*" Then 'OneDriveのパスかどうかの判定
'「https://･･･････/Documents」までの文字数を取得
CharPosi = InStr(1, Url, "/Documents") + 10
'ローカルパス作成
Url = OneDrive & Replace(Mid(Url, CharPosi), "/", Application.PathSeparator)
Else
'OneDriveのパス以外だったらカレントドライブ指定
ChDrive Left(Url, 1)
End If
'作成したローカルパスを返す
UrlToLocal = Url
End Functionサンプルコード2
サンプルコード2でもうまくいかない場合は、サンプルコード3を試してください。
Option Explicit '変数の宣言を強制する
Sub エラー回避()
'ファイルがあるカレントドライブを指定
ChDir UrlToLocal(ThisWorkbook.Path)
'カレントドライブのフォルダを開く
Dim varFileName As Variant
varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
Title:="CSVファイルの選択")
'キャンセルボタンを選択した場合
If varFileName = False Then
Exit Sub
End If
End Sub
'--------以下「UrlToLocal」関数の記述--------------
Public Function UrlToLocal(ByRef Url As String) As String
'OneDrive環境変数を格納する変数の定義
Dim OneDrive As String
'OneDrive環境変数の取得
OneDrive = Environ("OneDrive")
' ＵＲＬからローカルパスを作成する
If Url Like "https://*" Then 'OneDriveのパスかどうかの判定
'ローカルパス作成
Url = OneDrive & Replace(Mid(Url, 41), "/", Application.PathSeparator)
Else
'OneDriveのパス以外だったらカレントドライブ指定
ChDrive Left(Url, 1)
End If
'作成したローカルパスを返す
UrlToLocal = Url
End Functionサンプルコード3
サンプルコード2では、ローカルパスを作成する際に文字数から判断していましたが、サンプルコード3では「/」の位置を求めてローカルパスを作成しています。
Option Explicit '変数の宣言を強制する
Sub エラー回避()
'ファイルがあるカレントドライブを指定
ChDir UrlToLocal(ThisWorkbook.Path)
'カレントドライブのフォルダを開く
Dim varFileName As Variant
varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
Title:="CSVファイルの選択")
'キャンセルボタンを選択した場合
If varFileName = False Then
Exit Sub
End If
End Sub
'--------以下「UrlToLocal」関数の記述--------------
Public Function UrlToLocal(ByRef Url As String) As String
'OneDrive環境変数を格納する変数の定義
Dim OneDrive As String
'OneDrive環境変数の取得
OneDrive = Environ("OneDrive")
' ＵＲＬからローカルパスを作成する
If Url Like "https://*" Then 'OneDriveのパスかどうかの判定
'4番目の「/」の位置を取得
Dim FourthSlashPosition As Long
FourthSlashPosition = FindFourthSlashPosition(Url)
'カレントディレクトリのパスを作成
Url = OneDrive & Replace(Mid(Url, FourthSlashPosition), "/", Application.PathSeparator)
Else
'OneDriveのパス以外だったらカレントドライブ指定
ChDrive Left(Url, 1)
End If
'作成したローカルパスを返す
UrlToLocal = Url
End Function
'---------------------------------------------------------------------------
'4番目の「/」の位置を求める関数
Function FindFourthSlashPosition(ByVal text As String) As Long
Dim firstSlashPos As Long
Dim secondSlashPos As Long
Dim thirdSlashPos As Long
Dim fourthSlashPos As Long
firstSlashPos = InStr(1, text, "/")
If firstSlashPos > 0 Then
secondSlashPos = InStr(firstSlashPos + 1, text, "/")
If secondSlashPos > 0 Then
thirdSlashPos = InStr(secondSlashPos + 1, text, "/")
If thirdSlashPos > 0 Then
fourthSlashPos = InStr(thirdSlashPos + 1, text, "/")
If fourthSlashPos > 0 Then
FindFourthSlashPosition = fourthSlashPos
Else
' ４番目の「/」が見つからなかった場合の処理
FindFourthSlashPosition = -1
End If
Else
' ３番目の「/」が見つからなかった場合の処理
FindFourthSlashPosition = -1
End If
Else
' ２番目の「/」が見つからなかった場合の処理
FindFourthSlashPosition = -1
End If
Else
' 最初の「/」が見つからなかった場合の処理
FindFourthSlashPosition = -1
End If
End Function