VBScript コード例

'OS情報を取得する.vbs
'https://beagle-dog.com/vbscript-wmi/

Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
Set colOS = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each os In colOS
    WScript.Echo "Caption: " & os.Caption
    WScript.Echo "Version: " & os.Version
    WScript.Echo "BuildNumber: " & os.BuildNumber
    WScript.Echo "LastBootUpTime: " & os.LastBootUpTime
Next

' Create and Auto-Name a Text File.vbs

Set objFSO = CreateObject("Scripting.FileSystemObject")

strPath = "C:\temp"
strFileName = objFSO.GetTempName
' 拡張子を ".tmp" から ".txt" に置き換える
strFileName = Left(strFileName, Len(strFileName) - 3) & "txt"
WScript.Echo "FileSystemObject.GetTempName = " & strFileName

strFullName = objFSO.BuildPath(strPath, strFileName)
WScript.Echo "FileSystemObject.GetTempName = " & strFullName

Set objFile = objFSO.CreateTextFile(strFullName)
objFile.WriteLine("これはテストです。")

    With objFile
        For i = 1 To 5
            'イミディエイトウィンドウへ出力位置と値を表示
            WScript.Echo "行 = " & .Line & _
                        "　位置 = " & .Column & _
                        "　値 = " & i
            '文字列出力（改行なし）
            .Write i
        Next

        .Close  'ファイルのクローズ
    End With
objFile.Close
'objFSO.DeleteFile(strFullName) ファイルを削除したい場合に使う

'オブジェクト変数のクリア
Set objFSO = Nothing
Set objFile = Nothing
	
'' Runメソッドでファイルを開く
'' 第2引数: ウィンドウのスタイル (ここでは通常ウィンドウで表示)
'' 第3引数: 同期実行するかどうか (ここでは非同期実行 False)

WScript.CreateObject("WScript.Shell").Run strFullName

'★ファイル一覧出力VBS4.vbs
'フォルダ内のファイル一覧を取得
'https://bayashita.com/p/entry/show/33
'WScriptオブジェクトを利用する
'https://atmarkit.itmedia.co.jp/ait/articles/0705/17/news121_2.html
'ファイルのstrExtension
'https://bayashita.com/p/entry/show/75

'ファイルを開くダイアログを使ってファイルを選択する部分は ChatGPT に教えてもらいました。

Option Explicit

Dim fso, initialDir
Dim objFolder
Dim objFileSys
Dim objOutputTextStream
Dim App
Dim selectedFile
Dim strExtension

' ====================================================================
' 1. 実行している VBS ファイルがあるフォルダのパスを取得
' ====================================================================
Set fso = CreateObject("Scripting.FileSystemObject")
' WScript.ScriptFullName は VBS ファイル自体のフルパス
' GetParentFolderName で、そのファイルが入っているフォルダのパスを取得します
initialDir = fso.GetParentFolderName(WScript.ScriptFullName)
initialDir = Replace(initialDir, "'", "''")  'パスに「'（シングルクォート）」がある場合エスケープ

' ====================================================================
' 2. PowerShell を呼び出してファイル選択ダイアログを表示
' ====================================================================
' PowerShellのコマンドを組み立てます
' ※ InitialDirectory に先ほど取得した initialDir を指定しています
Dim cmd
cmd = "powershell -NoProfile -ExecutionPolicy Bypass -WindowStyle Hidden -Command " & _
"""Add-Type -AssemblyName System.Windows.Forms; " & _
"$f = New-Object System.Windows.Forms.OpenFileDialog; " & _
"$f.InitialDirectory = '" & initialDir & "'; " & _
"$f.Filter = 'All files (*.*)|*.*'; " & _
"if ($f.ShowDialog() -eq 'OK') { $f.FileName }"""
'備考：
'�@ 初期フォルダを指定できる
'$f.InitialDirectory = 'C:\example'
'�A フィルタも自由に設定可能
'$f.Filter = 'テキスト (*.txt)|*.txt|CSV (*.csv)|*.csv'
'�B 複数選択も可能
'$f.Multiselect = $true
'この場合
'$f.FileNames
'で複数取得できます（VBS側の処理は少し工夫が必要）

' 実行
'https://www.bugbugnow.net/2018/06/wshrunexec.html
'https://atmarkit.itmedia.co.jp/ait/articles/0407/08/news101.html
Dim sh, ex ', selectedFile
Set sh = CreateObject("WScript.Shell")
Set ex = sh.Exec(cmd)
'WScript.ShellオブジェクトのExecメソッドは、類似するRunメソッドと異なり、
'戻り値のWshShellExecオブジェクトを通じて立ち上げた子プロセスの標準入力／出力／エラー出力に
'アクセスできます。
selectedFile = ex.StdOut.ReadLine
'VBScriptで外部コマンドを実行する方法・Execメソッド

' ====================================================================
' 3. 選択されたファイルパスの確認（実際の処理はここから始まる）
' ====================================================================
If selectedFile <> "" Then
   ' WScript.Echo "選択されたファイル: " & vbCrLf & selectedFile
   ' ' 選択されたファイルが取得できました
Else
    WScript.Echo "キャンセルされました。"
End If

'*******************
Dim start 'As Variant
Dim last  'As Variant
   start = Now                ' 開始時刻を変数に格納します。

'親フォルダのパスを格納する変数宣言
Dim strParentFolder

strParentFolder = Left(selectedFile, InStrRev(selectedFile, "\") )
'GetExtensionNameメソッド
strExtension = UCase(fso.GetExtensionName(selectedFile))

'MsgBox strParentFolder
'WScript.Quit

Dim strFullName '出力用テキストファイル
strFullName = "Files_" & strExtension & ".txt"
'ログ出力用 TextStream オブジェクトを作成
'第2引数は 1 ：読み取り、2 ：上書き、3 ：追記。
Set objOutputTextStream = fso.OpenTextFile(strFullName, 2, True)

Call SearchFile(strParentFolder)

'TextStream は Close を忘れずに
objOutputTextStream.Close

Set objOutputTextStream = Nothing
Set fso = Nothing
Set sh = Nothing
Set ex = Nothing

'' Runメソッドで出力したテキストファイルを開く
'MsgBox strFullName
'' 第2引数: ウィンドウのスタイル (ここでは通常ウィンドウで表示)
'' 第3引数: 同期実行するかどうか (ここでは非同期実行 False)
WScript.CreateObject("WScript.Shell").Run strFullName

   last = Now
   'VBScriptでのFormat関数の代わり FormatDateTime
   'https://www.kanaya440.com/contents/script/vbs/function/string/format_datetime.html
   MsgBox "処理時間は、" _
   & FormatDateTime(last - start, vbLongTime) & " でした。",,"処理時間"

'*******************
'★再帰処理でファイル抽出★
Sub SearchFile(strParentFolder)

   Dim objFolder 'As Object
   Dim objFile 'As Object
   Dim objFile1 'As Object
   Dim fso 'As Object
   Dim strExtensionAll
   Dim strFullPath
   Dim strFileName

   Set fso = CreateObject("Scripting.FileSystemObject")

   If Not fso.FolderExists(strParentFolder) Then
      MsgBox "ファイル無し"
      Exit Sub
   End If

   Set objFolder = fso.GetFolder(strParentFolder)

   'FolderオブジェクトのFilesプロパティからFileオブジェクトを取得
   For Each objFile1 In objFolder.Files
      strFullPath = objFile1.Path
      strFileName = objFile1.Name

      'strExtensionを取得
      strExtensionAll = fso.GetExtensionName(objFile1.Name)

      If Ucase(strExtensionAll) = strExtension then
         '★★★出力するstrExtensionを限定★★★
         'ファイルフルパスを取得し、ログファイルに出力
         strFileName = CleanSpecialChars(strFileName)
         strFullPath = CleanSpecialChars(strFullPath)

         objOutputTextStream.WriteLine strFileName & VbTab & strFullPath
      End If
   Next

   Set objFile = objFolder.SubFolders
   For Each objFile1 In objFile
      If (objFile1.Attributes And (2 + 4)) = 0 Then '2 : Hidden 隠しファイル、4 : System システム ファイル
         Call SearchFile(objFile1.Path)
      End If
   Next

   Set objFolder  = Nothing
   Set fso = Nothing
End Sub

Function CleanSpecialChars(text)
   ' 複数の特定の制御文字を消す。Gemini に教えてもらいました
   Dim result
   result = text
    
   ' 消したい文字を順次 Replace していく
   result = Replace(result, ChrW(&H0096), "?") ' U+0096 ラテン1補助
   result = Replace(result, ChrW(&H0092), "?") ' U+0092 ラテン1補助 "’"
   result = Replace(result, ChrW(&H000B), "?") ' 垂直タブなど、他にあれば追加
   
   CleanSpecialChars = result
End Function

'★ファイル一覧出力jpgJPG2.vbs
'フォルダ内のファイル一覧を取得
'https://bayashita.com/p/entry/show/33
'WScriptオブジェクトを利用する
'https://atmarkit.itmedia.co.jp/ait/articles/0705/17/news121_2.html
'ファイルの拡張子
'https://bayashita.com/p/entry/show/75

Option Explicit
 
Dim objFileSys
Dim objFolder
Dim objFile
Dim objOutputTextStream
Dim strExtension
 
'ファイルシステムを扱うオブジェクトを作成
Set objFileSys = CreateObject("Scripting.FileSystemObject")
 
'ログ出力用 TextStream オブジェクトを作成
'第2引数は 1 ：読み取り、2 ：上書き、3 ：追記。
Set objOutputTextStream = objFileSys.OpenTextFile("★FilesVBS_JPG.txt", 2, True)

'親フォルダのパスを格納する変数宣言
Dim strParentFolder
'スクリプトが存在するフォルダの親フォルダのパスを取得
'実行しているスクリプト名を、保存パスを含めて取得するのは、WScript.ScriptFullName プロパティです。
'実行しているスクリプト名を取得するのは、WScript.ScriptName プロパティです。
strParentFolder = objFileSys.GetParentFolderName(WScript.ScriptFullName)

'親フォルダのオブジェクトを取得
Set objFolder = objFileSys.GetFolder(strParentFolder)
 
'FolderオブジェクトのFilesプロパティからFileオブジェクトを取得
For Each objFile In objFolder.Files
'拡張子を取得
strExtension = objFileSys.GetExtensionName(objFile.Name)
   '★★★出力する拡張子を限定★★★
   if UCase(strExtension) = "JPG" then
       'ファイル名を取得し、ログファイルに出力
       objOutputTextStream.WriteLine objFile.Name
   end if
Next
 
'TextStream は Close を忘れずに
objOutputTextStream.Close

Set objOutputTextStream = Nothing
Set objFolder  = Nothing
Set objFileSys = Nothing 

'MsgBox "終了しました!", vbOKOnly

'' Runメソッドでファイルを開く
'' 第2引数: ウィンドウのスタイル (ここでは通常ウィンドウで表示)
'' 第3引数: 同期実行するかどうか (ここでは非同期実行 False)

WScript.CreateObject("WScript.Shell").Run "★FilesVBS_JPG.txt"

'---taskmgr.vbs ファイル
'https://oshiete.goo.ne.jp/qa/8367319.html
'https://answers.microsoft.com/ja-jp/windows/forum/windows_10-start-winpc/
'windows10%E3%81%A7%E3%82%BF%E3%82%B9%E3%82%AF/96601980-be3f-4023-8ff4-b5d82ba53b00?auth=1
'taskmgr.exeが対話型のためです。
'ショートカット（.lnk）ではなくて、つぎのようなscriptファイル（taskmgr.vbs）をスタートアップに置いてみてください。
'ただし、サインイン時にタスクマネージャが表示されるのに5秒程度かかります。
'なお、単純にtaskmgrだけを .bat や .cmd ファイルにするとコマンドプロンプト画面も表示されてしまいます。
'したがって、.vbs でコマンドプロンプトを非表示にしています。

WScript.CreateObject("WScript.Shell").Run "taskmgr.exe", 2, True

'object.Run(strCommand, [intWindowStyle], [bWaitOnReturn]) 

'IntWindowStyle
'0 ウィンドウを非表示にし、別のウィンドウをアクティブにします。 
'2 ウィンドウをアクティブにし、最小化ウィンドウとして表示します。 

'VBScript でソートする (unibon)
'unibonSort.vbs
'http://www.geocities.co.jp/SiliconValley/4334/unibon/asp/sort.txt

'上のサイトが消えているため、ここに掲載させていただきます。
'下記の種類のソートを選択利用できます。
'バブルソート、挿入ソート、選択ソート、クイックソート、
'ヒープソート、シェルソート、マージソート、計数ソート
'動かすと要素数とソートアルゴリズムを聞いてきますので、指定してください。
'(キーは1から数えて)年齢を第1キー、名前を第2キーとしてソートします。
'したがって年齢が同じなら、名前のアルファベット順でソートされていることになります。
Option Explicit

Sub swap(ByRef x, ByRef y) ' 汎用の交換用(計数ソート以外のすべてのアルゴリズムで使う)
    Dim d
    Set d = x
    Set x = y
    Set y = d
End Sub

Sub sortBubble(ByRef a()) ' バブルソート
    Dim i
    For i = 0 To UBound(a) - 1
        Dim j
        For j = i + 1 To UBound(a)
            If a(j).compareTo(a(i)) < 0 Then
                Call swap(a(j), a(i))
            End If
        Next
    Next
End Sub

Sub sortInsertionSub(ByRef a(), ByVal p, ByVal q) ' 挿入ソート(計数ソートの内部用) p <= x <= q (両端を含む)
    Dim i
    For i = p + 1 To q
        Dim j
        For j = i To p + 1 Step -1
            If a(j).compareTo(a(j - 1)) < 0 Then
                Call swap(a(j), a(j - 1))
            Else
                Exit For
            End If
        Next
    Next
End Sub

Sub sortInsertion(ByRef a()) ' 挿入ソート
    Dim i
    For i = 1 To UBound(a)
        Dim j
        For j = i To 1 Step -1
            If a(j).compareTo(a(j - 1)) < 0 Then
                Call swap(a(j), a(j - 1))
            Else
                Exit For
            End If
        Next
    Next
End Sub

Sub sortSelection(ByRef a()) ' 選択ソート
    Dim i
    For i = 0 To UBound(a) - 1
        Dim k
        k = i
        Dim j
        For j = i + 1 To UBound(a)
            If a(j).compareTo(a(k)) < 0 Then
                k = j
            End If
        Next
        If k <> i Then ' 必須ではない
            Call swap(a(k), a(i))
        End If
    Next
End Sub

Sub sortQuickSub(ByRef a(), ByVal p, ByVal q) ' クイックソート(内部ルーチン)
    If q - p = 1 Then ' 必須ではない
        If a(q).compareTo(a(p)) < 0 Then
            Call swap(a(q), a(p))
        End If
        Exit Sub
    End If

    Dim i
    i = p
    Dim j
    j = q
    Dim x
    Set x = a(p)
    Do
        Do While a(i).compareTo(x) < 0
            i = i + 1
        Loop
        Do While x.compareTo(a(j)) < 0
            j = j - 1
        Loop

        If i >= j Then
            Exit Do
        End If

        Call swap(a(j), a(i))

        i = i + 1
        j = j - 1
    Loop

    If p < i - 1 Then
        Call sortQuickSub(a, p, i - 1)
    End If

    If j + 1 < q Then
        Call sortQuickSub(a, j + 1, q)
    End If
End Sub

Sub sortQuick(ByRef a()) ' クイックソート
    If 0 < UBound(a) Then
        Call sortQuickSub(a, 0, UBound(a))
    End If
End Sub

Sub sortHeapSub(ByRef a(), ByVal p, ByVal s) ' ヒープソート(内部ルーチン)
    If p * 2 + 2 > s Then
        Exit Sub
    End If

    Dim m
    If p * 2 + 2 = s Then
        m = p * 2 + 1
    Else
        If a(p * 2 + 2).compareTo(a(p * 2 + 1)) < 0 Then
            m = p * 2 + 1
        Else
            m = p * 2 + 2
        End If
    End If

    If a(p).compareTo(a(m)) < 0 Then
        Call swap(a(p), a(m))
        Call sortHeapSub(a, m, s)
    End If
End Sub

Sub sortHeap(ByRef a()) ' ヒープソート
    Dim i
    For i = (UBound(a) + 1) \ 2 - 1 To 0 Step -1
        Call sortHeapSub(a, i, UBound(a) + 1)
    Next
    For i = UBound(a) To 1 Step -1
        Call swap(a(i), a(0))
        Call sortHeapSub(a, 0, i)
    Next
End Sub

Sub sortShell(ByRef a()) ' シェルソート
    If UBound(a) <= 0 Then
        Exit Sub
    End If

    Dim h
    h = 1
    Dim k
    k = 0
    Dim m()
    Do While h <= UBound(a) + 1
        ReDim Preserve m(k)
        m(k) = h
        h = 3 * h + 1
        k = k + 1
    Loop

    For k = UBound(m) To 0 Step -1
        h = m(k)
        Dim i
        For i = h To UBound(a)
            Dim j
            For j = i To h Step -h
                If a(j).compareTo(a(j - h)) < 0 Then
                    Call swap(a(j), a(j - h))
                Else
                    Exit For
                End If
            Next
        Next
    Next

    Erase m
End Sub

Sub sortMergeSub(ByRef a(), ByVal p, ByVal q, ByRef w()) ' マージソート(内部ルーチン)
    If q - p = 1 Then ' 必須ではない
        If a(q).compareTo(a(p)) < 0 Then
            Call swap(a(q), a(p))
        End If
        Exit Sub
    End If

    Dim c
    c = (p + q) \ 2

    If p < c Then
        Call sortMergeSub(a, p, c, w)
    End If

    If c + 1 < q Then
        Call sortMergeSub(a, c + 1, q, w)
    End If

    ' ReDim w(q - p)

    Dim i
    i = p
    Dim j
    j = c + 1
    Dim k
    For k = 0 To q - p
        Dim m
        If i <= c And j <= q Then
            If a(i).compareTo(a(j)) < 0 Then
                m = True
            Else
                m = False
            End If
        Else
            If i <= c Then
                m = True
            Else
                m = False
            End If
        End If
        If m Then
            Set w(k) = a(i)
            i = i + 1
        Else
            Set w(k) = a(j)
            j = j + 1
        End If
    Next

    For k = 0 To q - p
        Set a(k + p) = w(k)
    Next

    ' Erase w
End Sub

Sub sortMerge(ByRef a()) ' マージソート
    If 0 < UBound(a) Then
        ReDim w(UBound(a))
        Call sortMergeSub(a, 0, UBound(a), w)
        Erase w
    End If
End Sub

Class DicClass ' 計数ソート内でのソート用クラス
    Dim dicKey
    Dim dicItem
    Function compareTo(ByRef o) ' 比較関数
        If dicKey < o.dicKey Then
            compareTo = -1
        ElseIf dicKey > o.dicKey Then
            compareTo = 1
        Else
            compareTo = 0
        End If
    End Function
End Class

Sub sortCount(ByRef a()) ' 計数ソート
    If UBound(a) <= 0 Then
        Exit Sub
    End If

    Dim c
    Set c = CreateObject("Scripting.Dictionary") ' ディクショナリオブジェクトを使用する

    Dim i
    For i = 0 To UBound(a)
        Dim k
        k = a(i).getKey()
        If c.Exists(k) Then ' Not IsEmpty(c(k)) でも良い
            c(k) = c(k) + 1
        Else
            Call c.Add(k, 1)
        End If
    Next

    ReDim d(c.Count - 1)
    Dim t
    t = 0
    For Each k In c
        Dim o
        Set o = New DicClass
        o.dicKey = k
        o.dicItem = c(k)
        Set d(t) = o
        t = t + 1
    Next
    Set o = Nothing

    Call sortQuick(d) ' この計数ソート内で計数ソート以外のいずれかのソートを呼び出す

    ReDim e(UBound(d))

    For t = 0 To UBound(d)
        If t > 0 Then
            d(t).dicItem = d(t).dicItem + d(t - 1).dicItem
        End If
        c(d(t).dicKey) = d(t).dicItem
        e(t) = d(t).dicItem
    Next

    Erase d

    ReDim w(UBound(a))
    For i = UBound(a) To 0 Step -1
        k = a(i).getKey()
        c(k) = c(k) - 1
        Set w(c(k)) = a(i)
    Next

    ' Call c.RemoveAll()
    Set c = Nothing

    For i = 0 To UBound(a)
        Set a(i) = w(i)
    Next

    Erase w

    For t = 0 To UBound(e)
        Dim u
        If t = 0 Then
            u = 0
        Else
            u = e(t - 1)
        End If
        If u < e(t) - 1 Then
            Call sortQuickSub(a, u, e(t) - 1)
        End If
    Next

    Erase e
End Sub

Function isIllegalOrder(ByRef a())
    Dim i
    For i = 1 To UBound(a)
        If a(i).compareTo(a(i - 1)) < 0 Then
            isIllegalOrder = True
            Exit Function
        End If
    Next
    isIllegalOrder = False
End Function

Function isIllegalDup(ByRef a())
    Dim c
    Set c = CreateObject("Scripting.Dictionary") ' ディクショナリオブジェクトを使用する

    Dim i
    For i = 0 To UBound(a)
        Dim k
        k = a(i).getID()
        If c.Exists(k) Then ' Not IsEmpty(c(k)) でも良い
            isIllegalDup = True
            ' Call c.RemoveAll()
            Set c = Nothing
            Exit Function
        Else
            Call c.Add(k, Empty)
        End If
    Next

    isIllegalDup = False
    ' Call c.RemoveAll()
    Set c = Nothing
End Function

Class PersonClass
    Dim intID ' ID
    Dim intAge ' 年齢
    Dim strName ' 名前
    Function compareTo(ByRef o) ' 計数ソート以外のソート用の比較関数
        If intAge < o.intAge Then
            compareTo = -1
        ElseIf intAge > o.intAge Then
            compareTo = 1
        Else ' 年齢が同じ場合は名前でソートする
            If strName < o.strName Then
                compareTo = -1
            ElseIf strName > o.strName Then
                compareTo = 1
            Else
                compareTo = 0
            End If
        End If
    End Function
    Function getKey() ' 計数ソート用キー
        getKey = Right("00" & CStr(intAge), 2) & Left(strName, 1)
    End Function
    Function getID() ' ID
        getID = intID
    End Function
End Class

'サンプル・データを生成
Sub samplePerson()
    Const methodBubble = 0
    Const methodInsertion = 1
    Const methodSelection = 2
    Const methodQuick = 3
    Const methodHeap = 4
    Const methodShell = 5
    Const methodMerge = 6
    Const methodCount = 7

    Dim y
    y = Array("バブル", "挿入", "選択", "クイック", "ヒープ", "シェル", "マージ", "計数")

    Dim n
    n = InputBox("テストデータの要素数を指定してください。" & vbNewLine _
	& "指定した要素数に合わせて、乱数でデータを自動生成します。", "要素数")
    If IsEmpty(n) Then ' キャンセルされた
        Exit Sub
    End If
    n = CLng(n)

    ' ソートアルゴリズムをどれかひとつ使う
    Dim m
    m = InputBox("ソート手法を指定してください。" & vbNewLine _
 & "0: バブル" & vbNewLine & "1: 挿入" & vbNewLine _
 & "2: 選択" & vbNewLine & "3: クイック" & vbNewLine _
 & "4: ヒープ" & vbNewLine & "5: シェル" & vbNewLine _
 & "6: マージ" & vbNewLine & "7: 計数" & vbNewLine, "ソート手法")
    If IsEmpty(m) Then ' キャンセルされた
        Exit Sub
    End If
    m = CLng(m)

    ReDim a(n - 1) ' 人数分の要素数

    Dim o
    Dim i
    For i = 0 To UBound(a)
        Set o = New PersonClass
        o.intID = CLng(i)
        o.intAge = CLng(Int(Rnd(1) * 10) + 5)
        o.strName = Chr(Asc("A") + CLng(Int(Rnd(1) * 6))) & Chr(Asc("A") + CLng(Int(Rnd(1) * 6))) _
        & Chr(Asc("A") + CLng(Int(Rnd(1) * 6))) & Chr(Asc("A") + CLng(Int(Rnd(1) * 6)))
        Set a(i) = o
    Next
    Set o = Nothing

    Dim ta
    ta = Timer()

    If m = methodBubble Then
        Call sortBubble(a) ' バブルソート
    ElseIf m = methodInsertion Then
        Call sortInsertion(a) ' 挿入ソート
    ElseIf m = methodSelection Then
        Call sortSelection(a) ' 選択ソート
    ElseIf m = methodQuick Then
        Call sortQuick(a) ' クイックソート
    ElseIf m = methodHeap Then
        Call sortHeap(a) ' ヒープソート
    ElseIf m = methodShell Then
        Call sortShell(a) ' シェルソート
    ElseIf m = methodMerge Then
        Call sortMerge(a) ' マージソート
    ElseIf m = methodCount Then
        Call sortCount(a) ' 計数ソート
    Else
        Call MsgBox("illegal method")
        Exit Sub
    End If

    Dim tb
    tb = Timer()

    Dim bo
    bo = isIllegalOrder(a)
    If bo Then
        Call MsgBox("illegal order")
        Exit Sub
    End If

    Dim bd
    bd = isIllegalDup(a)
    If bd Then
        Call MsgBox("illegal dup")
        Exit Sub
    End If

    Dim s
    s = "要素数: " & (UBound(a) + 1) & "個" & vbNewLine & "手法: " & y(m) & vbNewLine & "処理時間: " & ((tb - ta) * 1000) & "[ms]" & vbNewLine
    Dim f
    f = False
    For i = 0 To UBound(a)
        If i < 10 Or i >= UBound(a) + 1 - 10 Then
            s = s & a(i).intID & "番 " & a(i).intAge & "才 " & a(i).strName & "さん" & vbNewLine
        ElseIf f = False Then
            s = s & "中略" & vbNewLine
            f = True
        End If
    Next

    Call MsgBox(s) ' クライアントサイド(IE)の場合

    Erase a
End Sub

Call samplePerson()

Option Explicit

'テストデータ生成スクリプト
'Orders.csv (50,000件) と ItemMaster.csv (15,000件) を生成します。

Randomize 42   ' Pythonのseed(42)に相当（完全一致ではないが再現性確保）

Const NUM_ITEMS = 15000
Const NUM_SUPPLIERS = 200
Const NUM_ORDERS = 50000

Dim fso, itemFile, orderFile
Set fso = CreateObject("Scripting.FileSystemObject")

' UTF-8で書き込むためにADODB.Streamを使用
Function CreateUtf8Writer(filePath)
    Dim stm
    Set stm = CreateObject("ADODB.Stream")
    stm.Type = 2 ' テキスト
    stm.Charset = "utf-8"
    stm.Open
    Set CreateUtf8Writer = stm
End Function

Sub SaveStream(stm, filePath)
    stm.SaveToFile filePath, 2 ' 上書き
    stm.Close
End Sub

Function RandChoice(arr)
    RandChoice = arr(Int(Rnd * (UBound(arr) + 1)))
End Function

Function RandUniform(min, max)
    RandUniform = min + (max - min) * Rnd
End Function

Function RandInt(min, max)
    RandInt = Int((max - min + 1) * Rnd) + min
End Function

' ─── 品目マスタ生成 ─────────────────
Dim suppliers()
ReDim suppliers(NUM_SUPPLIERS - 1)

Dim i
For i = 0 To NUM_SUPPLIERS - 1
    suppliers(i) = "仕入先_" & Right("0000" & (i + 1), 4)
Next

WScript.Echo "ItemMaster.csv を生成中..."

Dim stmItem
Set stmItem = CreateUtf8Writer("ItemMaster.csv")

' ヘッダ
stmItem.WriteText "品目コード,仕入先,単価,重量" & vbCrLf

Dim item_code, supplier, unit_price, weight

For i = 1 To NUM_ITEMS
    item_code = "ITEM-" & Right("000000" & i, 6)
    supplier = RandChoice(suppliers)
    
    unit_price = Round(RandUniform(100, 50000), 2)
    weight = Round(RandUniform(0.1, 50.0), 3)
    
    stmItem.WriteText item_code & "," & supplier & "," & unit_price & "," & weight & vbCrLf
Next

SaveStream stmItem, "ItemMaster.csv"

WScript.Echo "  完了: " & NUM_ITEMS & " 件"

' ─── 注文データ生成 ─────────────────
Dim item_codes_existing(), item_codes_missing()

ReDim item_codes_existing(NUM_ITEMS - 1)
For i = 1 To NUM_ITEMS
    item_codes_existing(i - 1) = "ITEM-" & Right("000000" & i, 6)
Next

ReDim item_codes_missing(499)
For i = 1 To 499
    item_codes_missing(i - 1) = "ITEM-" & Right("000000" & (NUM_ITEMS + i), 6)
Next

WScript.Echo "Orders.csv を生成中..."

Dim stmOrder
Set stmOrder = CreateUtf8Writer("Orders.csv")

' ヘッダ
stmOrder.WriteText "品目コード,数量" & vbCrLf

Dim item_code2, quantity

For i = 1 To NUM_ORDERS
    If Rnd < 0.05 Then      ' 5%: 未照合
        item_code2 = RandChoice(item_codes_missing)
    Else
        item_code2 = RandChoice(item_codes_existing)
    End If
    
    quantity = RandInt(1, 1000)
    
    stmOrder.WriteText item_code2 & "," & quantity & vbCrLf
Next

SaveStream stmOrder, "Orders.csv"

WScript.Echo "  完了: " & NUM_ORDERS & " 件"
WScript.Echo "テストデータ生成が完了しました。"