スポンサーリンク

Explorer元ウィンドウはそのままでショートカット先のフォルダを開くVBS(ファイル選択版)

以前公開したvbsの少しパワーアップ版になります。
元ウィンドウはそのままでショートカット先のフォルダを開くVBS - engineer-kiyoの日記
変更点はファイルのショートカットを開くときに、エクスプローラウィンドウでファイルを選択状態にします。
地味な変更ですが私としては使いやすくなったと思ってます。

■現状の不満
Windowsエクスプローラでショートカットファイルを右クリックして「フォルダーの場所を開く」「ファイルの場所を開く」だと元のウィンドウは失われて新しい場所に遷移する。
※もちろん上記動作で良い場合は上記の操作してます。
ショートカットを右クリック時に「新しいウィンドウで開く」が使えればこんなvbsは不要なんですけどね。マイクロソフトさん何とかしてください。

■ショートカットファイルをこのVBSに渡すと以下の動作をします。
①ショートカットがフォルダの場合、元のウィンドウはそのままでそのフォルダを開く
②ショートカットがファイルの場合、元のウィンドウはそのままでそのファイルがあるフォルダを開く。目的のファイルは選択状態になる。

■使い方
以下のスクリプトテキストエディタに張り付けて、「ショートカットのリンク先フオルダを開く(vbs).vbs」という名前で保存。

上記vbsファイルへのショートカットを以下のフォルダにコピー

C:\Users[user_id]\AppData\Roaming\Microsoft\Windows\SendTo

これでショートカットを右クリック → 送る → ショートカットのリンク先フオルダを開く(vbs).vbs で使えます。

'-------------------------------------------------------------------------------
' 機能概要  :ショートカット先のフォルダを開く(ファイル or フォルダ)
' 引数      : (I/ ) ショートカットファイル(複数可)
' 戻り値    : なし
' 備考      : 
' 使い方    :①このvbsファイルへのショートカットファイルを作成
'             ②上記ショートカットを以下のフォルダにコピーする。
'               C:\Users\[userid]\AppData\Roaming\Microsoft\Windows\SendTo
'             ③ショートカットファイルを右クリック ⇒ 送る ⇒ ②でコピーしたショートカットをクリック
'-------------------------------------------------------------------------------
Dim strExName , strPath
Dim arg
Dim oFso
Set oFso = CreateObject("Scripting.FileSystemObject")
Dim sCmd
Dim objShell
Set objShell = CreateObject("Wscript.Shell")


' パラメータがあれば処理実行
If WScript.Arguments.Count > O Then
    ' パラメータすべてに対して実行
    For Each arg In WScript.Arguments
        ' 拡張子取得
        strExName = oFso.GetExtensionName(arg)
        ' リンクの場合
        If UCase(strExName) ="LNK" Then
            ' パスを取得
            strPath = CreateObject("WScript.Shell").CreateShortCut(arg).TargetPath
            ' ■フォルダーが存在する場合(フォルダへのショートカットの場合)
            If oFso.FolderExists(strPath) = True Then
                'そのフォルダパスをそのまま使う。
                'フォルダを開く
                CreateObject("Shell.Application").Open strPath
            Else
                ' ■フオルダーが存在しない場合(ファイルへのショートカットの場合)
                ' ファイルが存在する場合
                If oFso.FileExists(strPath) = True Then
                    ' 一つ上のフォルダのパスを取得
                    ' コマンド文字列作成。/selectで選択状態にするファイルを指定
                    sCmd = "cmd /c explorer.exe /select," & strPath
                    objShell.Run sCmd,vbHide
                Else
                    'ファイルが存在しない場合
                    msgbox "ファイルが見つかりません。"
                End If
            End If
        End If
    Next
End If