シャットダウンダイアログを開く( VBscript, Jscript, C#, C# in PowerShell, PowerShell, PHP, Python, Ruby )

ALT + F4



デスクトップをクリックまたは、デスクトップだけを表示してこのショートカットで開きます。Windows のアプリケーションは通常このショートカットで終了します。(タイトルバーの左上のアイコンをクリックするとメニューが表示されてその中にあります)



VBScript
set objShell = CreateObject("shell.application")
call objShell.ShutdownWindows()

Shell.ShutdownWindows method

Jscript
var objShell = new ActiveXObject("shell.application");
objShell.ShutdownWindows();


C# : VisualStudio
using System;

namespace ShutdownDialog
{
	class Program
	{
		static void Main(string[] args)
		{
			dynamic shell = Activator.CreateInstance(Type.GetTypeFromProgID("shell.application"));
			shell.ShutdownWindows();

		}
	}
}


PowerShell 内で C#
$code = @"
using System;
public class MyClass {
	public static void Main() {

		dynamic shell = Activator.CreateInstance(Type.GetTypeFromProgID("shell.application"));
		shell.ShutdownWindows();

	}
}
"@

Add-Type -Language CSharp -TypeDefinition $code -ReferencedAssemblies ("Microsoft.CSharp")

[MyClass]::Main()


PowerShell のみ
$shell = New-Object -ComObject Shell.Application
$shell.ShutdownWindows()


PHP
<?php
$shell = new COM( "shell.application" );
$shell->ShutdownWindows();
?>


Python
import win32com.client
shell = win32com.client.Dispatch("shell.application")
shell.ShutdownWindows()

pywin32 が必要なので、こちらを参照してください

Ruby
require 'win32ole'
shell = WIN32OLE.new('shell.application')
shell.ShutdownWindows()






小さな VBScript 集


SendToフォルダを開くスクリプト
Set obj = CreateObject("Shell.Application")
Set objFolder = obj.NameSpace( &h09 )
obj.Explore(objFolder.Self.Path)

MDB 作成

C:\Windows\SysWOW64\cscript.exe create_mdb.vbs
Set obj = CreateObject("ADOX.Catalog")
obj.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=sample.mdb;"


GUID 取得
Set TypeLib = CreateObject("Scriptlet.TypeLib")
Call InputBox("コピーして使用して下さい","新しい GUID を取得しました",TypeLib.Guid)



シャットダウンダイアログ
Set Shell = Wscript.CreateObject( "Shell.Application" )
Shell.ShutdownWindows()


管理者コマンドプロンプト
Set obj = Wscript.CreateObject("Shell.Application")
obj.ShellExecute "cmd.exe", "/k", "", "runas", 1


アクセス可能な階層を持つフォルダのサイズ
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFolder = objFSO.GetFolder("c:\temp") 
Wscript.Echo objFolder.Size 


空の zip ファイルの作成
Set Fso = CreateObject( "Scripting.FileSystemObject" )
Set Handle = Fso.CreateTextFile( "empty.zip", True )
EmptyData = Chr(&H50) & Chr(&H4B) & Chr(&H5) & Chr(&H6)
EmptyData = EmptyData & String( 18, Chr(0) )
Handle.Write EmptyData
Handle.Close


Excel から PDF 作成
Set ExcelApp = CreateObject( "Excel.Application" )
Set MyBook = ExcelApp.Workbooks.Open( "Book1.xlsx" )
Call MyBook.ExportAsFixedFormat( 0, "Book1.pdf" )
ExcelApp.Quit()



VBScript : 既存の Excel を PDF に変換する ( ExportAsFixedFormat )



単純な一覧データを出力した PDF の見本




Excelで名前を付けて保存で PDF に保存できますが、これはスクリプトで行うコードです。
( プリンタが使える状態でないと動作しません )

ExportAsFixedFormat メソッド

XlFixedFormatType

.wsf で作成しています。もともと、.wsf のほうが簡単に外部ライブラリを参照したり、オブジェクトを最初から定義できるのでコードが簡潔になります。ここでは、Excel.Application 内で定義されている定数も参照して使えるようにしています。

Excel 側では、印刷設定により一行目のタイトルを常に表示するようにしたり、A4 横にして縮小したりしています。シートは二つありますが、PDF に変換すると全て出力されます。


<JOB>
<OBJECT id="Fso" progid="Scripting.FileSystemObject" />
<OBJECT id="ExcelApp" progid="Excel.Application" />
<REFERENCE guid="00020813-0000-0000-C000-000000000046" />
<SCRIPT language="VBScript">
' Wscript.Echo xlTypePDF,xlTypeXPS

' **************************************
' スクリプトのあるディレクトリの取得
' **************************************
strCurPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurPath )
Set obj = obj.ParentFolder
strCurPath = obj.Path

' 途中で異常終了すると、Excel がプロセスに残ってしまうので表示させています。
' マウス等で Excel 本体を操作しないで下さい。
' Excel を表示させたくない場合は、以下を削除または行頭に ' でコメントにして下さい
ExcelApp.Visible = True

Dim MyBook
Dim FilePath

' ここで Excel を参照するダイアログが開きます
FilePath = ExcelApp.GetOpenFilename("Excel ファイル (*.xlsx;*.xls), *.xlsx;*.xls", 1, "Excel ファイルの選択") 
if FilePath = "False" Then 
	MsgBox "Excel ファイルの選択がキャンセルされました"
	' スクリプト終了
	Wscript.Quit()
End If

' ここで Excel に読み込んでいます
on error resume next
' Workbook を取得( スクリプトと同じディレクトリ )
Set MyBook = ExcelApp.Workbooks.Open( FilePath )
if Err.Number <> 0 then
	' 終了( 開放 )
	ExcelApp.Quit()
	Wscript.Echo Err.Description & vbCrLf & FilePath
	' スクリプト終了
	Wscript.Quit()
end if
on error goto 0

Dim aPath
Dim strFileName
Dim aExt

' Excel の名前部分を取り出して、pdf の名前部分にします
aPath = Split(FilePath, "\")
strFileName = aPath(Ubound(aPath))
aExt = Split(strFileName,".")
strFileName = aExt(0)

' スクリプトと同じフォルダに保存されます
Call MyBook.ExportAsFixedFormat( xlTypePDF, strCurPath & "\" & strFileName & ".pdf" )

' 終了( 開放 )
ExcelApp.Quit()

' 終了確認
Wscript.Echo "処理が終了しました"

</SCRIPT>
</JOB>


Microsoft の記事

Application.GetOpenFilename メソッド

Microsoft の英文の記事

Saving Workbooks to PDF and XPS Formats in Excel 2007




VBScript : キーストロークを送信してキー操作をした事にする( 例 : リモート デスクトップ接続ダイアログ )

リモート デスクトップ接続は開いた後、詳細画面が表示されないので、ALT+O を送り、その後 SHIFT+TAB でタブを選択して、右矢印で次のタブに移動させます。 ALT+O SHIFT+TAB > 右矢印 画面タブで設定
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run( "mstsc.exe" )

WScript.Sleep(500)
WshShell.AppActivate("リモート デスクトップ接続")
WScript.Sleep(500)

' キーストロークを送信
WshShell.SendKeys ("%O")
WScript.Sleep(500)
WshShell.SendKeys ("+{TAB}")
WScript.Sleep(500)
WshShell.SendKeys ("{RIGHT}")

※ キーストロークの送信は環境や状況によっては、うまく動作しないかもしれません。その場合は適宜変更して下さい (キーストローク詳細 / SendKeys メソッド)




VBScript : ファイルのパスや名前をクリップボードへ( ダブルクォートなし ) / 送るフォルダに保存

エクスプローラで、SHIFT キーを押しながら右クリックすると『パスとしてコピー』がありますが、ダブルクォートが付加されています( たいていはそのほうがいいのですが )ので、ダブルクォートのないパスを取得します


▼ こんな感じで取得されます
"C:\Program Files\7-Zip\7-zip.dll"

filepath.vbs( SendTo ディレクトリに置いてください )

Set WshShell = Wscript.CreateObject("WScript.Shell")
Set Fso = Wscript.CreateObject("Scripting.FileSystemObject")

strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
strPath = strTemp & "\__clipCommand.tmp"

Set objHandle = Fso.OpenTextFile( strPath, 2, True )
objHandle.Write Wscript.Arguments(0)

Call WshShell.Run( "cmd.exe /c clip < """ & strPath & """", 0, True )
▼ こうなります
C:\Program Files\7-Zip\7-zip.dll

以下はディレクトリ部分を省いた名前の部分のみをクリップボードにコピーします。

filename.vbs( SendTo ディレクトリに置いてください )

Set WshShell = Wscript.CreateObject("WScript.Shell")
Set Fso = Wscript.CreateObject("Scripting.FileSystemObject")

strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
strPath = strTemp & "\__clipCommand.tmp"

Set objHandle = Fso.OpenTextFile( strPath, 2, True )
strName = Wscript.Arguments(0)
aPath = Split(strName,"\")
strName = aPath(Ubound(aPath))
objHandle.Write strName

Call WshShell.Run( "cmd.exe /c clip < """ & strPath & """", 0, True )

▼ こうなります
7-zip.dll

さらに以下では、複数ファイルを選択した場合のファイル名部分だけを取り出して複数行としてコピーします( 但しあまり大量のファイルは元々の文字列の制限によりエラーとなります

filelist.vbs( SendTo ディレクトリに置いてください )

Set WshShell = Wscript.CreateObject("WScript.Shell")
Set Fso = Wscript.CreateObject("Scripting.FileSystemObject")

str = ""
For I = 0 to Wscript.Arguments.Count-1
	aData = Split( Wscript.Arguments(I), "\" )
	str = str & aData(Ubound(aData)) & vbCrLf
Next

strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
strPath = strTemp & "\__clipCommand.tmp"

Set objHandle = Fso.OpenTextFile( strPath, 2, True )
objHandle.Write str
Call WshShell.Run( "cmd.exe /c clip < """ & strPath & """", 0, True )

▼ ファイルが多すぎて起きるエラー


▼ うまくいくとこんな感じです
nslookup.exe
ntdll.dll
odbc32.dll
ole32.dll


操作補足

エクスプローラで SendTo フォルダに移動するには、アドレスバーに sendto と直接入力します。テンポラリフォルダは、%temp% と入力して下さい。




コードを直接ダウンロードした場合は、右クリックのプロパティより『許可する』にチェックしておきます。






コマンドプロンプトを『管理者権限』で実行する 8つの方法

Windowsキー + X のメニューから

タスクバーの左端を右クリックして表示されるメニューです。『コマンドプロンプト(管理者)』を使う事が可能です、無い場合は設定変更で表示できます。
【PowerShell を コマンドプロンプトに変更 ※説明あり

Windowsキー + S の検索から

cmd と入力して CTRL+SHIFT+Enter で管理者権限でコマンドプロンプトを表示できます

タスクマネージャーから

ファイルメニューより、新しいタスクの実行を選択する事で、管理者権限を付与してプログラムを実行できます



Windowsキー + R で cmd を実行してから

タスクバーに表示されている『コマンドプロンプト』を、CTRL+SHIFT を押しながらクリックします

ショートカット を作成してから

ショートカット作成時に cmd と入力すると参照後のショートカットが作成されます。そのショートカットを右クリックして『管理者として実行』を選択します。また、ショートカットタブの詳細設定より、『管理者として実行』をチェックしておくと常に管理者として実行できるようになります

VBScript を使う
Set obj = CreateObject("Shell.Application")
obj.ShellExecute "cmd.exe", "", "", "runas", 1


バッチファイル を使う

結局先ほどの VBScript のコードですが、バッチファイルにそれを作らして実行する事ができるので .bat として用意できます
@echo off
echo Set obj = CreateObject("Shell.Application"):obj.ShellExecute "cmd.exe", "", "", "runas", 1 > %TEMP%\_acmd.vbs
cscript %TEMP%\_acmd.vbs


PowerShell を使う

PowerShell そのものはいろいろ説明が面倒ですが、PowerShell を実行する時のオプションとして考えてもらうのが簡単です( エイリアスとかもありますけれど )
powershell -windowstyle hidden -command start cmd -verb runas
-windowstyle と -command は powershell のオプションで、start は powershell の内部コマンドである Start-Process のエイリアスで、-verb は start のオプションです

この場合、-windowstyle hidden はあっても無くてもあまり変わらないと思います。


XCOPY で新しいファイルのみバックアップする為のスクリプトを作成するスクリプト / VBScript

⭕ ディレクトリ選択でバックアップするフォルダを決定 ⭕ カレント(このスクリプトを実行したフォルダ)にスクリプトが作成されます ⭕ 新しいスクリプトを実行 ⭕ カレントにバックアップ用のフォルダが作成されます ⭕ バックアップするフォルダ内をそのフォルダ内に全てコピーします ▼ 実行時に表示されるフォルダ選択 XCOPY なので、2回目以降は新しいファイルのみコピーします ▼ 作成されたスクリプトのサンプルです
strName = "BK_C_temp_lightbox"
strTarget = "C:\temp\lightbox"
strBackupFolder = "C:\tmp\vbs"
if MsgBox( strTarget & vbCrLf & "のバックアップを開始します。よろしいですか? (保存先:" & strBackupFolder & "\" & strName & ")", 1 ) = 2 then
	Wscript.Quit
end if
Set WshShell = Wscript.CreateObject( "WScript.Shell" )
ExecCommand = "cmd.exe /C ""xcopy.exe """ & strTarget & """ """ & strBackupFolder & "\" & strName & "\"" /D /E /C /S /Y & PAUSE"""
Call WshShell.Run( ExecCommand )


▼ 使用するオプション
/D : コピー元の日付がコピー先の日付より新しいファイルだけをコピーします
/E : ディレクトリまたはサブディレクトリが空であってもコピーします
/C : エラーが発生してもコピーを続けます
/S : 空の場合を除いて、ディレクトリとサブディレクトリをコピーします
/Y : 既存のファイルを上書きする前に確認のメッセージを表示しません
一番重要なのは、/D です。/S /E で、存在するディリクトリはすべてコピーされます。/E /Y によって、最後まで停止する事なく実行されます。 追加で使う事が想定されるオプション コピーしたくないディレクトリやファイルがある場合、以下のように指定します。 /EXCLUDE:ファイルのパス ファイルのパスが示すテキストファイル内に、除外するディレクトリやファイルにある文字列の一部を1 行に 1 つずつ記述します。 その文字列が、コピー対象ファイルの絶対パスの一部と一致した場合、そのファイルはコピーから除外されます。 ▼ 例 ⭕ "\obj\" という文字列を指定するとディレクトリ obj の下の全ファイルが除外 されます。 ⭕ ".obj" という文字列を指定すると .obj という拡張子のファイルがすべて除外されます ソースコード
' ***********************************************************
' 処理開始
' ***********************************************************
Set Fso = Wscript.CreateObject( "Scripting.FileSystemObject" )
Set Shell = Wscript.CreateObject( "Shell.Application" )

' ***********************************************************
' 実行中ディレクトリの取得
' ***********************************************************
strPath = Wscript.ScriptFullName 
Set objFile = Fso.GetFile( strPath )
strBackupFolder = Fso.GetParentFolderName( objFile )

' ***********************************************************
' バックアップ対象ディレクトリの取得
' ***********************************************************
' ① 省略すると、ルートはデスクトップ
Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B )

' ② 文字列による直接指定
' strRoot = "c:\"
' Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B, strRoot )

' ③ ルートを番号で指定( この場合は C:\Users\username\AppData\Local )
' ※ あまり現実的ではない特殊ディレクトリの選択
' nRoot = &h1c
' Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B, nRoot )

if objFolder is nothing then
	WScript.Quit
end if
if not objFolder.Self.IsFileSystem then
	WScript.Echo "ファイルシステムではありません"
	WScript.Quit
end if

strTargetFolder = objFolder.Self.Path
strName = Replace( strTargetFolder, ":", "" )
strName = Replace( strName, "\", "_" )
strName = Replace( strName, " ", "" )
strName = "BK_" & strName

' ***********************************************************
' スクリプト作成
' ***********************************************************
Set OutFile = Fso.OpenTextFile( strBackupFolder & "\" & strName & ".vbs", 2, True )

OutFile.WriteLine "strName = """ & strName & """"
OutFile.WriteLine "strTarget = """ & strTargetFolder & """"
OutFile.WriteLine "strBackupFolder = """ & strBackupFolder & """"
OutFile.Write "if MsgBox( strTarget & vbCrLf & ""のバックアップを開始します。よろしいですか? (保存先:"" & strBackupFolder & ""\"" & strName & "")"""
OutFile.WriteLine ", 1 ) = 2 then"
OutFile.WriteLine "	Wscript.Quit"
OutFile.WriteLine "end if"

OutFile.WriteLine "Set WshShell = Wscript.CreateObject( ""WScript.Shell"" )"
OutFile.Write "ExecCommand = ""cmd.exe /C """"xcopy.exe """""" & strTarget & """""" """""" & strBackupFolder & ""\"" & strName & ""\"""""
OutFile.WriteLine " /D /E /C /S /Y & PAUSE"""""""
OutFile.WriteLine "Call WshShell.Run( ExecCommand )"

OutFile.Close

WScript.Echo "バックアップスクリプト : " &  strName & ".vbs" & " を作成しました"


' ***********************************************************
' ディレクトリ指定用番号
' https://docs.microsoft.com/ja-jp/windows/desktop/api/shldisp/ne-shldisp-shellspecialfolderconstants
' typedef enum {
' 	ssfALTSTARTUP = 0x1d,
' 	ssfAPPDATA = 0x1a,
' 	ssfBITBUCKET = 0x0a,
' 	ssfCOMMONALTSTARTUP = 0x1e,
' 	ssfCOMMONAPPDATA = 0x23,
' 	ssfCOMMONDESKTOPDIR = 0x19,
' 	ssfCOMMONFAVORITES = 0x1f,
' 	ssfCOMMONPROGRAMS = 0x17,
' 	ssfCOMMONSTARTMENU = 0x16,
' 	ssfCOMMONSTARTUP = 0x18,
' 	ssfCONTROLS = 0x03,
' 	ssfCOOKIES = 0x21,
' 	ssfDESKTOP = 0x00,
' 	ssfDESKTOPDIRECTORY = 0x10,
' 	ssfDRIVES = 0x11,
' 	ssfFAVORITES = 0x06,
' 	ssfFONTS = 0x14,
' 	ssfHISTORY = 0x22,
' 	ssfINTERNETCACHE = 0x20,
' 	ssfLOCALAPPDATA = 0x1c,
' 	ssfMYPICTURES = 0x27,
' 	ssfNETHOOD = 0x13,
' 	ssfNETWORK = 0x12,
' 	ssfPERSONAL = 0x05,
' 	ssfPRINTERS = 0x04,
' 	ssfPRINTHOOD = 0x1b,
' 	ssfPROFILE = 0x28,
' 	ssfPROGRAMFILES = 0x26,
' 	ssfPROGRAMFILESx86 = 0x30,
' 	ssfPROGRAMS = 0x02,
' 	ssfRECENT = 0x08,
' 	ssfSENDTO = 0x09,
' 	ssfSTARTMENU = 0x0b,
' 	ssfSTARTUP = 0x07,
' 	ssfSYSTEM = 0x25,
' 	ssfSYSTEMx86 = 0x29,
' 	ssfTEMPLATES = 0x15,
' 	ssfWINDOWS = 0x24
' } ShellSpecialFolderConstants;
' ***********************************************************




関連する Microsoft ドキュメント

Shell Reference
Shell Objects for Scripting and Microsoft Visual Basic
Shell object
Shell.BrowseForFolder method



VBScript : Excel のブックを新規に作成する( .xlsx と .xls を選択 )

最新の Excel では新規で自動的に作成されるシートのデフォルトは一つです。但しそれは Excel のオプション設定で変更可能なので、必要であれば Book.Worksheets.Count というように現在のシート数を取得してコードを変更すれば良いと思います。

保存する形式としては、可能列挙型 (Excel) / SaveAs メソッド で使用する定数 より選択して SaveAs メソッドの第二引数に指定します。ここでは、.xls( 56 ) を使用しています
' ****************************
' Excel オブジェクト作成
' ****************************
Set App = CreateObject("Excel.Application")

' ****************************
' 警告を出さないようにする
' ****************************
App.DisplayAlerts = False

' ****************************
' ブック追加
' ****************************
App.Workbooks.Add()

' ****************************
' 追加したブックを取得
' ****************************
Set Book = App.Workbooks( App.Workbooks.Count )

' ****************************
' 現状、ブックにはシート一つ
' という前提で処理していますが
' 必要であれば、Book.Worksheets.Count
' で現在のシートの数を取得できます
' ****************************
Set Worksheet = Book.Worksheets( 1 )
Worksheet.Activate()

' ****************************
' Add では 第二引数に指定した
' オブジェクトのシートの直後に、
' 新しいシートを追加します。
' ****************************
Call Book.Worksheets.Add(,Worksheet)

' ****************************
' シート名設定
' ****************************
Book.Sheets(1).Name = "新しい情報"
Book.Sheets(2).Name = "予備情報"

' ****************************
' 参照
' 最後の 1 は、使用するフィルター
' の番号です
' ****************************
FilePath = App.GetSaveAsFilename(,"Excel ファイル (*.xlsx), *.xlsx,古いExcel ファイル (*.xls), *.xls", 1)
if FilePath = "False" Then
	MsgBox "Excel ファイルの保存選択がキャンセルされました"
	Wscript.Quit()
End If

' ****************************
' 保存
' 拡張子を .xls で保存するには
' Call ExcelBook.SaveAs( BookPath, 56 ) とします
' ****************************
on error resume next
if Ucase(Right(FilePath,3)) = "XLS" then
	Call Book.SaveAs( FilePath, 56 )
else
	Book.SaveAs( FilePath )
end if
if Err.Number <> 0 then
	MsgBox( "ERROR : " & Err.Description )
end if
on error goto 0

' ****************************
' Excel をアプリケーションとして終了
' ****************************
App.Quit()

' ****************************
' Excel を VBScript から開放
' ****************************
Set App = Nothing

' ****************************
' オブジェクト変数を初期化
' ( 初期化しないとオブジェクト扱いされる )
' ****************************
App = Empty


MsgBox( "処理が終了しました" )


Microsoft ドキュメント

Application.GetSaveAsFilename メソッド (Excel)

Application.GetOpenFilename メソッド (Excel)

Worksheets.Add メソッド (Excel)

Workbook.SaveAs メソッド (Excel)

可能列挙型 (Excel) / SaveAs メソッド で使用する定数








PATH 環境変数をセミコロンで区切って一行づつ表示するバッチファイル( path-list.bat )

echo で VBScript の実行文を表示して、%temp%\_.vbs に書き出してそのまま実行するという、バッチファイルです。システム用とユーザ用を別々に作成して実行しています。

PATH コマンドの代りに使えます。

@echo off
echo ▼ システム
cmd /c echo Set ws=WScript.CreateObject("WScript.Shell"):Set wv=ws.Environment("SYSTEM"):pt=wv("PATH"):ad=Split(pt,";"):For I=0 To Ubound(ad):Wscript.echo ws.ExpandEnvironmentStrings(ad(I)):Next>%temp%\_.vbs&cscript.exe /NOLOGO %temp%\_.vbs
echo ▼ ユーザ
cmd /c echo Set ws=WScript.CreateObject("WScript.Shell"):Set wv=ws.Environment("USER"):pt=wv("PATH"):ad=Split(pt,";"):For I=0 To Ubound(ad):Wscript.echo ws.ExpandEnvironmentStrings(ad(I)):Next>%temp%\_.vbs&cscript.exe /NOLOGO %temp%\_.vbs
pause







VBScript で架空の氏名を作成するスクリプト / ( .WSF )

選択する漢字によっては、さらに架空度が増します。

結果をコマンドプロンプトへ出力する事を前提としているので、Wscript.exe でスクリプトが実行された場合、Crun という関数で コマンドプロンプトを開いて cscript.exe でスクリプトを強制的に再実行させるようにしています。

<JOB>
<OBJECT id="WshShell" progid="WScript.Shell" />
<SCRIPT language="VBScript">
' ***********************************************************
' 処理開始
' ***********************************************************
nMax = 20	' 取得する人数

Crun

' 1、2 は教育漢字の最初
strName1 = "愛悪圧安暗案以位囲委意易異移胃衣遺医域育一印員因引飲院右宇羽"
strName2 = "雨運雲営映栄永泳英衛液益駅円園延沿演遠塩央往応横王黄億屋恩温"
strName3 = "男也一行樹之朗七人"
strName4 = "子代美恵"

For i = 1 to nMax

	' 姓1文字目
	nTarget = Random( 1, Len(strName1) )
	strName = Mid( strName1, nTarget, 1 )

	' 1文字目と2文字目が一致したら除外
	nTarget2 = nTarget
	Do while( nTarget = nTarget2 )
		nTarget2 = Random( 1, Len(strName1) )
	Loop

	' 姓2文字目
	strName = strName & Mid( strName1, nTarget2, 1 ) & " "

	' 名1文字目
	nTarget = Random( 1, Len(strName2) )
	strName = strName & Mid( strName2, nTarget, 1 )

	' 性別
	nTarget = Random( 0, 1 )

	' 性別によって名2文字目を決定
	if nTarget = 0 then
		nTarget = Random( 1, Len(strName3) )
		strName = strName & Mid( strName3, nTarget, 1 )
	else
		nTarget = Random( 1, Len(strName4) )
		strName = strName & Mid( strName4, nTarget, 1 )
	end if
	
	Wscript.Echo strName

Next

' ***********************************************************
' 範囲内ランダム値取得
' ***********************************************************
Function Random( nMin, nMax )

	Randomize
	Random = nMin + Int(Rnd * (nMax - nMin + 1))

End function

' ***********************************************************
' Cscript.exe で強制実行
' ***********************************************************
Function Crun( )

	Dim str

	str = WScript.FullName
	str = Right( str, 11 )
	str = Ucase( str )
	if str <> "CSCRIPT.EXE" then
		str = WScript.ScriptFullName
		strParam = " "
		For I = 0 to Wscript.Arguments.Count - 1
			if instr(Wscript.Arguments(I), " ") < 1 then
				strParam = strParam & Wscript.Arguments(I) & " "
			else
				strParam = strParam & Dd(Wscript.Arguments(I)) & " "
			end if
		Next
		Call WshShell.Run( "cmd.exe /c cscript.exe " & Dd(str) & strParam & " & pause", 3 )
		WScript.Quit
	end if

End Function

' ***********************************************************
' ダブルクォート
' ***********************************************************
Function Dd( strValue )

	Dd = """" & strValue & """"

End function

</SCRIPT>
</JOB>


💙 例えば...
院引 演恵
域院 雲恵
衣位 応行
印意 央樹
羽因 往恵
院意 応行
位胃 沿子
囲移 塩子
異因 映代
以引 雨人
圧因 塩代
域右 温七
易育 延七
右委 黄子
異引 雲美
圧衣 園朗
愛員 王七
悪右 英之
圧遺 益樹
院暗 横美