【SendTo】ネットワークドライブ上のパスをフルパス(UNCパス)に変換する

これは何？

ネットワークドライブ上のパスをフルパス(UNCパス)に変換してクリップボードにコピーするスクリプト。
SendToフォルダに置いて使う。(%APPDATA%\Microsoft\Windows\SendTo)

ネットワークドライブとは

ネットワーク上にある共有フォルダにドライブレターを割り当てて、ローカルPCのストレージと同じようにアクセスできる機能。

例：共有フォルダ「¥¥SERVER¥GROUP1¥SHARE」にドライブレター「H」を割り当てると
　　**¥¥SERVER¥GROUP1¥SHARE¥**xxx¥yyy¥zzz
に
　　**H:¥**xxx¥yyy¥zzz
でアクセスできる。

が、他の人にパスを連絡するときは前者(UNCパス)が必要になるので、ネットワークドライブ上のパスをUNCパスに楽に変換したい欲求が出てくる。

コード

ネットワークドライブ上のパスをUNCパスに変換.vbs

Option Explicit

Dim FSO:	Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WSH:	Set WSH = CreateObject("WScript.Shell")

Main

WScript.Quit



'***********************************************************
' メイン関数
'***********************************************************
Sub Main()
	Dim vbReturn
	Dim strArgument
	Dim strFullPath

	' コマンドラインのファイルを順に処理する
	For Each strArgument In WScript.Arguments.Unnamed
		' ファイルをUNCパスに変換
		strFullPath = GetUncPath(strArgument)
		If strFullPath = "" Then
			strFullPath = strArgument
		End If

		' UNCパスをクリップボードにコピー
		Call CopyToClipboard(strFullPath)

		vbReturn = MsgBox(strFullPath, vbOKCancel, "クリップボードにコピーしました。")
		If vbReturn = vbCancel Then
			Exit Sub
		End If
	Next
End Sub



'***********************************************************
' ファイルをUNCパスに変換
'***********************************************************
Function GetUncPath (strFile)
	Dim strDrive
	Dim strNetworkPath
	Dim strFullPath
	Dim wshExec
	Dim strCmdOutput

	' ドライブレター(「:」を含む)を抽出
	strDrive = Left(strFile, Instr(strFile, ":"))

	' 「net use」コマンドでドライブの情報を取得
	'
	' 【実行結果サンプル】
	'	ローカル名         X:
	'	リモート名         \\hostname\xxx\yyy\zzz
	'	リソースの種類     Disk
	'	ステータス         OK
	'	オープン数         *
	'	接続数             *
	'	コマンドは正常に終了しました。
	'
	strFullPath = ""
	Set wshExec = WSH.Exec("cmd /c net use " & strDrive)
	Do Until wshExec.StdOut.AtEndOfline
		strCmdOutput = wshExec.StdOut.ReadLine
		If Instr(strCmdOutput, "リモート名") <> 0 Then
			strNetworkPath = Trim(Right(strCmdOutput, Len(strCmdOutput)-5))
			strFullPath = Replace(strFile, strDrive, strNetworkPath)
		End If
	Loop

	GetUncPath = strFullPath
End Function


'***********************************************************
' テキストをクリップボードにコピー
'***********************************************************
Sub CopyToClipboard(strText)
	Dim wshExec

	' クリップボードへ出力
	Set wshExec = WSH.Exec("clip")
	wshExec.StdIn.Write(strText)
	wshExec.StdIn.Close()

	' 参照を解放する
	' メモ：ＭＳを信じれば(足を)すくわれる
	Set wshExec = Nothing
End Sub

更新履歴

2020/04/03　投稿
2020/04/07　タグ更新