忍者ブログ

ショートカットファイルのリンク先をショートパスで指定して文字数制限対策をした話

2023年10月06日
会社で使っているNASのリンク切れが激しい。。。2回目の呟き

リンク先修正時のリンク先存在チェックはひとまず置いておいて、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




PR
Comment
  Vodafone絵文字 i-mode絵文字 Ezweb絵文字