ショートカットファイルのリンク先をショートパスで指定して文字数制限対策をした話
リンク先修正時のリンク先存在チェックはひとまず置いておいて、NASのパスだけでも修正しようと久々にリンク先を取得するマクロを動かしてみた。
リンク先を取得するのにCreateShortcutを使ってるんだけど、引数の文字数が256バイトを超えるとエラーを吐くので、対策を考えてみた。
CreateObject("WScript.Shell").CreateShortcut(フルパスファイル名)
元ソースについては以下の記事を参照。
「ショートカットファイルのリンク先を置換するマクロ」
対象のファイルをローカルにコピーして情報取得も考えたけど、、、それの方が良いか。。。
ショートカットファイルのサイズは小さいもんね。別途やってみることにして、今回はファイルパスをショートパスで取得する方法をやってみた話。
今までDir関数でやっていたファイル存在チェックもFSOへ変更。
速度が遅いのは嫌なので、文字数が250バイトを超えたらショートパスを使ってリンク先を取得する。
ショートパスは以下の方法で取る。
CreateObject("Scripting.FileSystemObject").GetFile(LnkFileName).shortPath
以下ソース
Sub ショートカットファイルからリンク先を取得()
Dim WSH: Set WSH = CreateObject("WScript.Shell")
Dim objFS As Object: Set objFS = CreateObject("Scripting.FileSystemObject")
Dim objFile As Object
Dim LnkFile, DeskTopPath As String, LnkFileName As String
Dim Gyo As Long, GyoSt As Long, GyoEnd As Long
GyoSt = 8
GyoEnd = Cells(Rows.Count, "B").End(xlUp).Row
For Gyo = GyoSt To GyoEnd
DoEvents
Application.StatusBar = Gyo & "/" & GyoEnd & "件目を処理中"
Cells(Gyo, "A") = Gyo - GyoSt + 1
LnkFileName = Cells(Gyo, "B").Value
If Right(LnkFileName, 4) = ".lnk" Then '
If objFS.FileExists(LnkFileName) = True Then
If LenB(LnkFileName) > 250 Then
Set objFile = objFS.GetFile(LnkFileName) 'FSOを使ってショートネームを取得する
Set LnkFile = WSH.CreateShortcut(objFile.shortPath) 'lenb 256を超えるとエラーになるのでショートネームに
Else
Set LnkFile = WSH.CreateShortcut(LnkFileName) 'lenb 256を超えるとエラーになる
End If
Cells(Gyo, "C") = LnkFile.TargetPath
Else
Cells(Gyo, "E").Value = "No File"
Call 黄色網掛け(Gyo, "B")
End If
Else
Cells(Gyo, "E").Value = "Link Error"
Call 黄色網掛け(Gyo, "C")
End If 'If Right(LnkFileName, 4) = ".lnk" Then
Next Gyo
Set LnkFile = Nothing
Set WSH = Nothing
Application.StatusBar = ""
End Sub