Excelでネットワークパスフォルダのハイパーリンクを作るといつの間にか、相対パス（￥..￥..など）に変換されて、ファイルの場所を変えると開かなくなる
Excelの内部リンク管理が相対パス仕様の為
ファイルのプロパティでハイパーリンクの基点とする設定をすると良いがファイル毎に設定が必要となるのと、他で相対パスの方がよい場合もあるので注意が必要
対処として、ハイパーリンクを関数で設定することが考えられる
VBAでの通常のリンクコード 相対パスに変換されることがある
ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=folderPath, TextToDisplay:=linkText
数式でのコード 数式のパラメータとして絶対パスを設定するので変換されない
ActiveCell.Formula = “=HYPERLINK(“”” & folderPath & “””,””” & linkText & “””)”
具体例
Option Explicit
Sub フォルダリンク設定()
Dim WshShell As Object
Dim FSO As Object
Dim FILEPATH As String
Dim PathDrive As String
Dim SelectedFile As String
Dim folderPath As String
Dim linkText As String
Set WshShell = CreateObject(“WScript.Shell”) ‘ファイル操作を行う為のオブジェクト
‘ A1セルから初期フォルダパスを取得
On Error Resume Next
FILEPATH = Workbooks(“Personal.xlsb”).Worksheets(“Sheet1”).Range(“A1”).Value
On Error GoTo 0
If FILEPATH <> “” Then ‘記述されている時は存在チェック
Set FSO = CreateObject(“Scripting.FileSystemObject”)
If Not (FSO.FolderExists(FILEPATH)) Then
MsgBox “指定しているフォルダにアクセスできませんでした” & vbCrLf & vbCrLf & “ツールがあるフォルダを設定します”
FILEPATH = ActiveWorkbook.Path
End If
Set FSO = Nothing
Else
FILEPATH = ActiveWorkbook.Path ‘指定ないときはエクセルブックのフォルダ
End If
If Left(FILEPATH, 2) = “\\” Then ‘ネットワークのとき
WshShell.CurrentDirectory = FILEPATH ‘指定のネットワークフォルダをセット
Else
On Error Resume Next
PathDrive = Left(FILEPATH, 2) ‘chdirコマンドはドライブ指定があるとエラーなので、ドライブと分離
ChDrive PathDrive ‘ローカル時は、カレントドライブを変更
If FILEPATH <> “” Then ‘ルートディレクトリでフォルダ指定がないときには chdirコマンドがエラーとなるから処理をスキップ
ChDir FILEPATH
End If
On Error GoTo 0
End If
‘ファイル選択
SelectedFile = Application.GetOpenFilename(“All Files,*.*”, , “サンプルとなるファイルを選択してください”, , False)
‘キャンセルされた場合
If SelectedFile = “False” Then
MsgBox “ファイルの選択がキャンセルされました。”, vbInformation
Exit Sub
End If
‘フォルダパスを抽出
folderPath = Left(SelectedFile, InStrRev(SelectedFile, “\”) – 1)
‘ 表示するテキスト
linkText = “格納フォルダ”
‘選択したセルにハイパーリンクを設定
On Error Resume Next
ActiveCell.Formula = “=HYPERLINK(“”” & folderPath & “””,””” & linkText & “””)”
On Error GoTo 0
Set WshShell = Nothing
‘MsgBox “ハイパーリンクが作成されました: ” & folderPath, vbInformation
End Sub
Option Explicit
Sub 初期参照フォルダ値設定()
‘ 入力ダイアログを表示し、ユーザーに入力を求める
Dim userInput As Variant
userInput = InputBox(“初期参照フォルダを入力してください”)
‘ キャンセルがクリックされた場合は処理を終了
If userInput = “” Then Exit Sub
Workbooks(“Personal.xlsb”).Worksheets(“Sheet1”).Range(“A1”).Value = userInput
Application.DisplayAlerts = False
Workbooks(“Personal.xlsb”).Save ‘ブック名を指定した上書き保存
Application.DisplayAlerts = True
MsgBox userInput & ” を初期参照フォルダに指定しました”
End Sub