高速クリップ追加、デコード無

Option Explicit

Const CON_SCRIPTHOST = "cscript.exe"
Const WIN_SCRIPTHOST = "wscript.exe"
Const CMD_SET_CLIPBOARD = "clip.exe"

Const CLASSNAME_FSO = "Scripting.FileSystemObject"
Const CLASSNAME_HTML = "HTMLFile"
Const CLASSNAME_SHELL = "WScript.Shell"

Dim fso
Dim html
Dim shell
Set fso = CreateObject(CLASSNAME_FSO)
Set html = CreateObject(CLASSNAME_HTML)
Set shell = CreateObject(CLASSNAME_SHELL)

Call HideExec()

Sub HideExec()
    Dim arg
    Dim args

    '// エクスプローラからの起動を確認
    If (LCase(Right(WScript.FullName, 11)) = WIN_SCRIPTHOST) Then
        args = Array(CON_SCRIPTHOST, """" & WScript.ScriptFullName & """")

        For Each arg In WScript.Arguments
            ReDim Preserve args(UBound(args) + 1)
            args(UBound(args)) = """" & arg & """"
        Next

        '// 最小化ウィンドウで自身を呼び出し
        Call WScript.Quit(shell.Run(Join(args, " "), 7, True))
    Else
        '// 最小化ウィンドウでメインの処理を実行
        Call Main()
    End If
End Sub

Sub Main()
    On Error Resume Next

    Dim contents
    Dim exec

    '// クリップボード文字列取得
    contents = html.ParentWindow.ClipboardData.GetData("text")
    
    '// 先頭と末尾の " を削除
    If Left(contents, 1) = """" And Right(contents, 1) = """" Then
        contents = Mid(contents, 2, Len(contents) - 2)
    End If

    '// 文字列末端の vbNewLine を削除
    If Right(contents, Len(vbNewLine)) = vbNewLine Then
        contents = Left(contents, Len(contents) - Len(vbNewLine))
    End If

    ' 文字列の先頭と末尾に < と > を追加
    contents = "<" & contents & ">" & vbNewLine

    '// クリップボード文字列設定
    Set exec = shell.Exec(CMD_SET_CLIPBOARD)
    Call exec.StdIn.Write(contents)
    Call exec.StdIn.Close()
    Call exec.StdOut.ReadAll()

End Sub

---------------------------------------------

Option Explicit

Const CON_SCRIPTHOST = "cscript.exe"
Const WIN_SCRIPTHOST = "wscript.exe"
Const CMD_SET_CLIPBOARD = "clip.exe"

Const CLASSNAME_FSO = "Scripting.FileSystemObject"
Const CLASSNAME_HTML = "HTMLFile"
Const CLASSNAME_SHELL = "WScript.Shell"

Dim fso
Dim html
Dim shell
Set fso = CreateObject(CLASSNAME_FSO)
Set html = CreateObject(CLASSNAME_HTML)
Set shell = CreateObject(CLASSNAME_SHELL)

Call HideExec()

Sub HideExec()
    Dim arg
    Dim args

    '// エクスプローラからの起動を確認
    If (LCase(Right(WScript.FullName, 11)) = WIN_SCRIPTHOST) Then
        args = Array(CON_SCRIPTHOST, """" & WScript.ScriptFullName & """")

        For Each arg In WScript.Arguments
            ReDim Preserve args(UBound(args) + 1)
            args(UBound(args)) = """" & arg & """"
        Next

        '// 最小化ウィンドウで自身を呼び出し
        Call WScript.Quit(shell.Run(Join(args, " "), 7, True))
    Else
        '// 最小化ウィンドウでメインの処理を実行
        Call Main()
    End If
End Sub

Sub Main()
    On Error Resume Next

    Dim contents
    Dim exec

    '// クリップボード文字列取得
    contents = html.ParentWindow.ClipboardData.GetData("text")
    
    '// 先頭と末尾の " を削除
    If Left(contents, 1) = """" And Right(contents, 1) = """" Then
        contents = Mid(contents, 2, Len(contents) - 2)
    End If

'// パスをファイル名とディレクトリに分割
	Dim lastSlash
	lastSlash = InStrRev(contents, "\")
	Dim fileName
	Dim directoryPath

'// パス内にバックスラッシュが存在するか確認
If lastSlash > 0 Then
    fileName = Mid(contents, lastSlash + 1)
    directoryPath = Left(contents, lastSlash - 1)
Else
    ' バックスラッシュがない場合、ファイル名はcontents全体、ディレクトリパスは空
    fileName = contents
    directoryPath = ""
End If

'// 新しい形式でcontentsを設定
contents = "ファイル名：" & fileName & vbCrLf & "＜" & directoryPath & "＞"


    '// クリップボード文字列設定
    Set exec = shell.Exec(CMD_SET_CLIPBOARD)
    Call exec.StdIn.Write(contents)
    Call exec.StdIn.Close()
    Call exec.StdOut.ReadAll()

End Sub