FolderItem.InvokeVerbを使ってフォントをアンインストールするVBScript

エクスプローラにて右クリックメニューを選ぶ操作は、
WindowsAPIの名前空間オブジェクトを利用し
FolderItem.InvokeVerbメソッド実行によって実現できます。

フォントアンインストールは
フォントフォルダでの右クリックメニュー「削除」によって行えるので、
この操作をFolderItem.InvokeVerbを使ってスクリプト化できます。

FolderItem.InvokeVerbを使うことの何が便利かというと、
フォントファイルの実体が有る場所を探す必要がないということです。

特にWindows10 ver.1809以降ではログインユーザ毎にフォントがインストールできるのですが、
その結果フォントファイルの本体が%LOCALAPPDATA%に置かれるので
探しにいくのが面倒です。
でも、右クリックメニュー操作をトレースするのであれば
細かいことはすべてWindowsがやってくれるのでプログラマはそこを考えなくてすみます。

ただ、
右クリックメニュー操作をトレースしてる以上、
フォント削除確認ダイアログを表示してしまうのはどうにもなりません。

以下、サンプルソースです。

uninstallFont.vbs

Option Explicit
'===============================================================================
' 定数定義
'===============================================================================
Const ssfFONTS = 20 '特殊フォルダFONTSのID
Const ssfDESKTOP = 0

'===============================================================================
' グローバル変数
'===============================================================================
Dim objArg 'As Object
Dim fso 'As Object 'FileSystemObjectインスタンス
Dim objShell 'As Object 'Shellインスタンス

'===============================================================================
' メイン処理
'===============================================================================
Set objArg = Wscript.Arguments
If not (objArg.count = 1) then
    myEcho "    [！]引数：フォント名"

Else
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")

    myEcho(" ＞開始")
    Call uninstallFont(objArg(0))
    myEcho(" ＜終了")

    Set objShell = nothing
    Set fso = nothing
End If

Set objArg = nothing
WScript.Quit


'===============================================================================
' サブルーチン
'===============================================================================
Function uninstallFont(fontName) 'As Boolean
    uninstallFont = False

    'フォントフォルダの名前空間オブジェクトを取得する。
    Dim nsFontFolder
    Set nsFontFolder = objShell.Namespace(ssfFONTS)

    Dim fontItem 'As FolderItem
    For Each fontItem In nsFontFolder.Items
        If fontItem.IsFolder = False Then
            If InStr(1, fontItem.Name, fontName, 1) > 0 Then
                doVerb(fontItem)
            End If
        End If
    Next 'fontItem

    Set nsFontFolder = nothing
    uninstallFont = True
End Function

'*******************************************************************************
'* フォント削除実行
'*******************************************************************************
Sub doVerb(fontItem)
    '↓実際にアンインストールせず、確認する場合
    myEcho("Path= " & fontItem.Path & "/ Name=" & fontItem.Name)
    '※fontItem.Pathプロパティは実際のフォントファイル名を表すのではなく、
    '  フォント特殊フォルダ上での名前を表す。
    '  e.g. C:\Windows\Fonts\Century Regular/ Name=Century 標準

    fontItem.InvokeVerb("delete")
End Sub

'*******************************************************************************
'* 標準出力用
'*******************************************************************************
Sub myEcho(str)
    WScript.echo(str)
    '↓VBAで確認する場合はこちら
    'Debug.Print str
End Sub

'*******************************************************************************
'* InvorkVerbではなくVerbItem.DoItを使う場合
'*******************************************************************************
Sub verbDoIt(fontItem)
    Dim fontItemVerb 'As FolderItemVerb
    For Each fontItemVerb In fontItem.Verbs
        '&Rはプロパティ表示のVerb
        'If InStr(1, fontItemVerb.Name, "&R", 1) > 0 Then
        '&Dは削除のVerb
        If InStr(1, fontItemVerb.Name, "&D", 1) > 0 Then
            myEcho(fontItemVerb.Name)
            fontItemVerb.DoIt
        End If
    Next 'fontItemVerb
End Sub