動作確認

OSが起動しないPCのスペックを確認できる！VBScript製ツールを無料公開

VBScript版スペック表示ツール
  • 古いノートパソコンを手放したいけれど、スペックが分からない
  • Windowsが起動しない状態なので、確認すらできない
  • 検品時に最低限の情報（CPU・メモリ・ストレージなど）だけを手早く知りたい
  • 有料ソフトや商用ライセンスが気になってHWiNFOなどが使えない

こうしたお悩みをお持ちの方に向けて、筆者が自作した無料のPCスペック表示ツール（VBScript＋HTA形式）を紹介します。

このツールは、Windowsが起動しないパソコンでもWinPEなどの一時起動環境からUSBメモリで起動でき、OS非依存でスペックを確認できます。

  • インストール不要、起動するだけ
  • 商用でも使える無料ツール
  • CPUやメモリ構成、ストレージなどを自動で一覧表示
  • 必要に応じてテキストで保存も可能

非常に軽量かつ簡単な構成で、出品前の検品ツールとしても最適です。

ただし、VBScriptとWMICはすでにMicrosoftによって非推奨となっている技術であり、将来的な互換性については保証できません。

このあと解説すること

この記事では、以下の内容を詳しく紹介しています。

  • 実際の表示画面（画像つき）
  • スペック取得できる項目一覧
  • HTAファイルのソースコード全文
  • 実行手順と保存方法
  • カスタマイズする際のポイントと注意点

ツールの技術的な構成や注意点についてもあわせて解説していきます。

表示されるスペック項目一覧

ツール起動画面

本ツールを起動すると、スペック情報を自動で取得し、上記のような画面が表示されます。

取得されるスペック情報の詳細は以下です。

項目内容表示例
メーカー・型番本体に記載されたメーカー名・モデル名FUJITSU CLIENT COMPUTING LIMITED FMVU32023
CPU名称、クロック周波数Intel(R) Core(TM) i3-10110U CPU @ 2.10GHz
メモリ合計容量、スロット構成、型番4 GB（オンボード）
ストレージ型番、容量（USBメモリ等は除外）kbg4aznv128g kioxia（NVMe SSD 128GB [119.2GB]）
光学ドライブ型番を表示。
なければ「無し」などを表示。		無しor欠品
無線LAN無線アダプターのデバイス名をそのまま表示。WMIC経由で取得。Intel(R) Wi-Fi 6 AX201 160MHz
OSストレージにインストールされているWindowsのエディション・ビット数
※USBメモリからWinPE起動中でもCドライブなどのOSを取得。		Microsoft Windows 11 Pro（64 ビット）
バッテリー設計容量・実容量・劣化率（％表記、取得できた場合のみ）設計値: 23616 / 現在値: 22903（劣化 3 %）
Webカメラ内蔵カメラがある場合はデバイス名を表示。未搭載なら「無し」などを表示。無しor不明
画面サイズ・解像度実測サイズはWMIの物理寸法から対角を計算。近似して公称サイズで表示。解像度：13.3 インチ（1920 x 1080）

キーボード状態の選択と保存機能

ツール下部には「キーボードの状態」を選ぶオプションボタンがあります。

  • 正常
  • 不良
  • なし（物理キーボード非搭載のデスクトップパソコンなど）

いずれかを選択すると、「保存する（S）」ボタンが有効になり、ボタンクリックでスペック情報と選択内容をテキストファイル（.txt）として出力できます。

出力されるファイル名は、以下のような形式です

pc_spec_メーカー_型番_シリアル.txt
（例：pc_spec_FUJITSU_CLIENT_COMPUTING_LIMITED_FMVU32023_12345678.txt）

  • メーカー名：FUJITSU_CLIENT_COMPUTING_LIMITED
  • 型番：FMVU32023
  • シリアル番号：末尾20桁（例：12345678）

作成されたテキストファイルは、ツール本体（HTAファイル）と同じフォルダに保存されます。

たとえば、USBメモリ内にツールを置けば、保存先も自動的にUSBメモリ内になります。

出力されるファイルの内容例

保存されたテキストファイルには、以下のような形式で情報が記録されます。（キーボード状態「正常」選択時）

メーカー・型番：FUJITSU CLIENT COMPUTING LIMITED FMVU32023
CPU：Intel(R) Core(TM) i3-10110U CPU @ 2.10GHz
メモリ：4 GB（オンボード）
ストレージ：kbg4aznv128g kioxia（NVMe SSD 128GB [119.2GB]）
光学ドライブ：無しor欠品
無線LAN：Intel(R) Wi-Fi 6 AX201 160MHz
OS：Microsoft Windows 11 Pro（64 ビット）
バッテリー：設計値: 23616 / 現在値: 22903（劣化 3 %）
Webカメラ：無しor不明
画面サイズ・解像度：13.3 インチ（1920 x 1080）
キーボード：正常

このまま出品ページに転記したり、検品記録として保存したりするのに便利な形式です。

ツールの実行方法

このツールはシンプルな構成のため、通常の Windows 環境でも、WinPE 環境でも使用可能です。

ただし、WinPE 環境によっては正常に動作しない場合がありますので、実行時の注意点もあわせてご確認ください。

実行に必要なもの

項目内容
HTAファイル本ツールの本体ファイル（.hta形式）1つのみ
Windows環境通常のWindowsまたはWinPE環境（どちらでも実行可）
USBメモリ（任意）HTAファイルを保存・持ち運ぶための手段。
WinPE環境ではUSBに格納して使用するのが一般的。

実行手順（例：WinPE環境での使用）

  1. HTAファイルをUSBメモリにコピー
  2. PE起動用USBメモリをパソコンに接続し、WinPEを起動
  3. エクスプローラーを開いてUSBメモリの .hta ファイルをダブルクリック
  4. スペック情報が自動表示される

実行時の注意点

スクリプトがブロックされる環境では、セキュリティ設定の見直しが必要になることもあります。

一部のWinPE構成では、HTA実行に必要な mshta.exe が含まれていない、または無効化されている場合があります。

その場合は、HTAファイルを右クリックして「プログラムから開く」→「Microsoft (R) HTMLアプリケーション ホスト」を指定することで実行可能な場合があります。

Fujitsuノートパソコンの表示例
Fujitsuノートパソコンの表示例
HPノートパソコンの表示例
HPノートパソコンの表示例

よくある質問（Q&A）

ストレージや無線LANの項目が「無し」や「不明」になるのはなぜ？

ドライバが未適用だったり、WinPE環境で一部のデバイスが認識されていない場合に発生します。

このツールはWMIC経由で情報を取得しているため、ハードウェアとして認識されていない場合は取得不可となります。

バッテリー情報が表示されないことがあります。壊れているのでしょうか？

物理的にバッテリーが搭載されていない場合や、バッテリーデータが取得できない構成（BIOS側の制限など）の場合に表示されません。

WinPE環境では、一部の電源管理情報が制限される場合もあるため、完全な取得を保証するものではありません。

保存ボタンがグレーのまま有効になりません。

キーボード状態（正常・不良・なし）を選択しないと、保存ボタンは有効化されません。

これは「検品済みの判定」が明示されていない状態での保存を防ぐための仕様です。

ファイルがどこに保存されたか分かりません。

HTAファイルと同じ場所（同じフォルダ）に保存されます。

たとえば、USBメモリからHTAファイルを起動している場合は、USBメモリ内に保存されます。

カスタマイズ例（上級者向け）

このツールは、VBScriptとHTMLで構成されたHTAファイルのため、必要に応じて表示内容や処理内容を変更することができます。

以下では、実際のコードに沿ったカスタマイズ例を紹介します。

1. メモリの型番を省略し、合計だけを表示したい場合

初期状態では以下のように、スロットごとの型番まで含めて表示されます。

これをシンプルに「8 GB（オンボード）」や「8 GB」のみの表記にしたい場合は、以下の修正箇所を直します。

8 GB（4 GB M471B5273DH0-CH9 / 4 GB M471B5273CH0-CH9）
↓
8 GB（オンボード）

修正箇所

Function GetMem() 内の最後の戻り値を以下のように書き換えます。（290行目付近）

If onb Then
  GetMem = Round(t / 1073741824, 1) & " GB（オンボード）"
Else
  GetMem = Round(t / 1073741824, 1) & " GB"
End If

※ 型番の詳細を表示しないことで、出力内容が簡潔になります。

2. ストレージの型番ではなく「容量」のみを表示したい場合

Samsung SSD 750 EVO 500GB（SSD 500GB [465.8GB]）
↓
SSD 500GB

この場合、Function GetDrive() 内の results = results & ... で組み立てている部分（346行目付近）をカスタマイズします。

具体的には、devtype の文字列操作や stdSize のみを使って表示を調整します。

3. 「未搭載」の表記に統一したい場合

本ツールでは、光学ドライブやWebカメラ、バッテリーなど、機種によって搭載の有無が異なる項目については、あえて曖昧な表現（例：「無し」「欠品」「不明」など）を用いています。

たとえば、光学ドライブが認識されない場合、それが「最初から搭載されていない仕様」なのか、「取り外されて欠品している状態」なのかは、WMICなどからは判別できません。

そのため、出力時にはあえて「無しor欠品」「無しor不明」といった柔らかい表記にしてあります。

ただし、出力内容の表記を統一したい場合は、以下のように「未搭載」という表現に統一してしまうのも一つの方法です。

' 例：Webカメラ
GetCam = "未搭載"

' 例：光学ドライブ
GetODD = "未搭載"

' 例：バッテリー
GetBat = "未搭載"

4. キーボード状態の選択肢を変更したい（例：「確認済み」「未確認」など）

以下のHTML部分を編集すれば、表示と選択値を変更できます。（767行目付近）

<label><input type="radio" name="kb" value="確認済み" accesskey="Z" onclick="EnableSave()"> 確認済み(Z)</label>
<label><input type="radio" name="kb" value="未確認" accesskey="X" onclick="EnableSave()"> 未確認(X)</label>

また、Function GetKB() はそのまま選択値を取得するため、ロジック側の修正は不要です。

5. 出力ファイル名の形式を変更したい（例：日付付きにする）

ファイル名に以下のように出力日付を追加する場合は以下の修正を実施します。

pc_spec_メーカー型番シリアル.txt
↓
pc_spec_メーカー型番シリアル_20250705.txt

修正箇所

Sub SaveButton() 内で以下を追加します。（663行目付近）

Dim nowDate
nowDate = Year(Now) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2)
path = fso.GetParentFolderName(rawPath) & "\pc_spec_" & namePart & "_" & nowDate & ".txt"

関連ツール（PowerShell版）について

本記事で紹介したHTAツールは、VBScriptベースで動作するシンプルかつ軽量な構成です。

一方で、将来的な互換性や拡張性を重視したい場合には、PowerShell＋JavaScript＋HTA構成の上位版ツールもおすすめです。

こちらは現在、別記事にて公開予定です。

以下は、2つの構成の主な違いをまとめた比較表です。

項目VBScript版PowerShell版
軽量性非常に軽い標準的
互換性将来的に非推奨長期利用向き
WinPE対応要HTA組み込み要PowerShell＋HTA組み込み
拡張性初心者向けカスタム可能高度な処理も対応可能

現時点では、動作の軽さ・導入の手軽さを重視するならVBScript版、
機能の拡張やカスタマイズ性、将来の環境への適応性を重視するならPowerShell版が適しています。

ソースコード（VBScript＋HTA）

以下は、本記事で紹介した PCスペック表示ツール（VBScript＋HTA版） の全ソースコードです。

HTMLアプリケーション（.hta）形式で保存することで、Windows上でそのまま起動・利用できます。

実際にご自身でカスタマイズしたい場合も、このコードをベースに自由に編集可能です。

HTAファイルの作成手順

  1. メモ帳を開く
    Windowsのスタートメニューで「メモ帳」と検索して起動します。
  2. 本記事に掲載されているコードをコピー＆ペースト
    HTAソースコード全体を選択し、メモ帳に貼り付けます。
  3. ファイル名を pc_spec_extractor.hta として保存
    「名前を付けて保存」から、分かりやすいファイル名（例：pc_spec_extractor.hta）で保存します。
    ※ファイル名は任意ですが、拡張子が .hta になるようにしてください。
  4. 「文字コード」は「UTF-8」に設定
    文字コード（エンコード）は「UTF-8」を選んでください。「ANSI」などは、文字化けする可能性があります。
    • 保存したHTAファイルをダブルクリックで実行
      HTAファイルは、保存後にダブルクリックで実行できます。
      ※UAC（ユーザーアカウント制御）の警告が出た場合は「はい」で許可してください。
      pc_spec_extractor.hta（HTMLアプリケーション）のソースコード
      <!DOCTYPE html>
<html>
<head>
<meta charset="UTF-8">
<title>PC Spec Extractor</title>

<hta:application id="SpecTool" applicationname="PCSpecExtractor"
  border="thin" caption="yes" scroll="no"
  maximizebutton="no" minimizebutton="yes" sysmenu="yes"
  singleinstance="yes" />

<style>
html, body {
  margin: 0;
  padding: 0;
  height: 100%;
  font-family: 'Segoe UI', sans-serif;
  font-size: 14px;
  background: #f0f2f5;
  color: #222;
}
#wrapper {
  max-width: 720px;
  margin: 0 auto;
}
table {
  border-collapse: collapse;
  width: 100%;
  table-layout: fixed;
  max-width: 700px;
}
th {
  background: #34495e;
  color: #fff;
  text-align: left;
  padding: 8px;
}
td:first-child {
  width: 130px !important;
  max-width: 130px !important;
  background: #dfe6ec;
  font-weight: 600;
  color: #2c3e50;
}
td:nth-child(2) {
  background: #ffffff;
  color: #333;
  max-width: 480px;
  word-break: break-word;
  white-space: normal;
}

th, td {
  border: 1px solid #ccc;
  padding: 8px;
  word-break: break-word;
}
#controls {
  background: #d9e7f1;
  padding: 12px 16px;
  border-radius: 6px;
  margin-top: 16px;
}
.inline-group {
  display: flex;
  flex-wrap: wrap;
  align-items: center;
  gap: 14px;
}
button {
  padding: 6px 24px;
  font-weight: 600;
  font-size: 14px;
  background: #2a5d7f;
  color: #fff;
  border: 1px solid #2a5d7f;
  border-radius: 4px;
  cursor: pointer;
  transition: background 0.2s, border-color 0.2s;
}
button:hover {
  background: #1e4862;
  border-color: #1e4862;
}
</style>

<script language="VBScript">
Option Explicit

Sub InitSpecTable()
  AddRow "メーカー・型番", "取得中..."
  AddRow "CPU", "取得中..."
  AddRow "メモリ", "取得中..."
  AddRow "ストレージ", "取得中..."
  AddRow "光学ドライブ", "取得中..."
  AddRow "無線LAN", "取得中..."
  AddRow "OS", "取得中..."
  AddRow "バッテリー", "取得中..."
  AddRow "Webカメラ", "取得中..."
  AddRow "画面サイズ・解像度", "取得中..."
End Sub

Sub AddRow(label, value)
  Dim row, cell1, cell2
  Set row = Document.createElement("tr")
  Set cell1 = Document.createElement("td")
  Set cell2 = Document.createElement("td")

  cell1.innerText = label
  cell2.innerText = value

  row.appendChild cell1
  row.appendChild cell2
  specBody.appendChild row
End Sub

Sub UpdateMakerModel()
  specBody.rows(0).cells(1).innerText = GetSystemModel()
End Sub

Sub UpdateCPU()
  specBody.rows(1).cells(1).innerText = GetCPU()
End Sub

Sub UpdateMem()
  specBody.rows(2).cells(1).innerText = GetMem()
End Sub

Sub UpdateDrive()
  specBody.rows(3).cells(1).innerText = GetDrive()
End Sub

Sub UpdateODD()
  specBody.rows(4).cells(1).innerText = GetODD()
End Sub

Sub UpdateWiFi()
  specBody.rows(5).cells(1).innerText = GetWiFi()
End Sub

Sub UpdateOS()
  specBody.rows(6).cells(1).innerText = GetOS()
End Sub

Sub UpdateBat()
  specBody.rows(7).cells(1).innerText = GetBat()
End Sub

Sub UpdateCam()
  specBody.rows(8).cells(1).innerText = GetCam()
End Sub

Sub UpdateDisp()
  specBody.rows(9).cells(1).innerText = GetDisp()
End Sub

Sub LoadSpec()
  window.setTimeout GetRef("UpdateMakerModel"), 50
  window.setTimeout GetRef("UpdateCPU"), 100
  window.setTimeout GetRef("UpdateMem"), 150
  window.setTimeout GetRef("UpdateDrive"), 200
  window.setTimeout GetRef("UpdateODD"), 250
  window.setTimeout GetRef("UpdateWiFi"), 300
  window.setTimeout GetRef("UpdateOS"), 350
  window.setTimeout GetRef("UpdateBat"), 400
  window.setTimeout GetRef("UpdateCam"), 450
  window.setTimeout GetRef("UpdateDisp"), 500
End Sub

Function Safe(v)
  If IsNull(v) Or IsEmpty(v) Then
    Safe = ""
  Else
    Safe = v
  End If
End Function

Function IsPortableType()
  On Error Resume Next
  Dim it, types, i

  For Each it In WMIC("\\.\root\cimv2", "Select ChassisTypes from Win32_SystemEnclosure")
    If Not IsNull(it.ChassisTypes) Then
      types = it.ChassisTypes
      For i = LBound(types) To UBound(types)
        Select Case CInt(types(i))
          Case 8, 9, 10, 13, 14, 30
            If HasInternalDisplay() Then
              IsPortableType = True
              Exit Function
            End If
        End Select
      Next
    End If
  Next

  IsPortableType = False
End Function

Function HasInternalDisplay()
  On Error Resume Next
  Dim it, instanceName
  For Each it In WMIC("\\.\root\wmi", "Select InstanceName from WmiMonitorBasicDisplayParams")
    instanceName = LCase(it.InstanceName)

    ' 内蔵モニターとみなせるか判定（HDMIやDPなどは除外）
    If InStr(instanceName, "hdmi") = 0 And _
       InStr(instanceName, "dp") = 0 And _
       InStr(instanceName, "dvi") = 0 And _
       InStr(instanceName, "displayport") = 0 And _
       InStr(instanceName, "usb") = 0 Then
      HasInternalDisplay = True
      Exit Function
    End If
  Next
  HasInternalDisplay = False
End Function

Function WMIC(ns, q)
  Set WMIC = GetObject("winmgmts:" & ns).ExecQuery(q)
End Function

Function Safe(v)
  If IsNull(v) Or IsEmpty(v) Then Safe = "" Else Safe = v
End Function

' Win32_BIOSからシリアル番号を取得（表示には使わない）
Function GetSerial()
  Dim it
  For Each it In WMIC("\\.\root\cimv2", "Select SerialNumber from Win32_BIOS")
    GetSerial = Trim(it.SerialNumber)
    Exit Function
  Next
  GetSerial = "unknown"
End Function

Function GetSystemModel()
  Dim it, maker, model
  For Each it In WMIC("\\.\root\cimv2", "Select Manufacturer,Model from Win32_ComputerSystem")
    maker = Trim(Safe(it.Manufacturer))
    model = Trim(Safe(it.Model))
    
    ' モデル名がメーカー名で始まっていたら、メーカー名は省略（例：HP HP → HP）
    If LCase(Left(model, Len(maker))) = LCase(maker) Then
      GetSystemModel = model
    Else
      GetSystemModel = maker & " " & model
    End If
    
    Exit Function
  Next
  GetSystemModel = "不明"
End Function

Function GetCPU()
  Dim it, name, mhz, display
  For Each it In WMIC("\\.\root\cimv2", "Select Name,MaxClockSpeed from Win32_Processor")
    name = Trim(Safe(it.Name))
    mhz = CDbl(it.MaxClockSpeed)
    If InStr(name, "@") > 0 Then
      display = name
    Else
      display = name & "（" & FormatNumber(mhz / 1000, 2) & " GHz）"
    End If
    GetCPU = display
    Exit Function
  Next
  GetCPU = "不明"
End Function

Function GetMem()
  Dim it, t, l, onb, gb, pn
  t = 0 : l = "" : onb = True
  For Each it In WMIC("\\.\root\cimv2", "Select Capacity,PartNumber,FormFactor from Win32_PhysicalMemory")
    t = t + CDbl(it.Capacity)
    If Not (it.FormFactor = 11 Or it.FormFactor = 0) Then onb = False

    gb = Round(CDbl(it.Capacity) / 1073741824) ' 1GB = 1073741824 Bytes
    pn = Safe(it.PartNumber)
    pn = Trim(pn)
    If pn <> "" Then
      l = l & gb & " GB " & pn & " / "
    Else
      l = l & gb & " GB 不明 / "
    End If
  Next

  If l <> "" Then l = Left(l, Len(l) - 3)

  If onb Then
    GetMem = Round(t / 1073741824, 1) & " GB（オンボード）"
  Else
    GetMem = Round(t / 1073741824, 1) & " GB（" & l & "）"
  End If
End Function

Function GetDrive()
  On Error Resume Next
  Dim results, obj, media, iface, model, size, sizeGB, devtype, stdSize, pnpid, rpm
  results = ""

  For Each obj In WMIC("\\.\root\cimv2", "Select * from Win32_DiskDrive")
    iface = LCase(Trim(obj.InterfaceType))
    media = LCase(Trim(obj.MediaType))
    model = LCase(Trim(obj.Model))
    size = obj.Size
    pnpid = LCase(Trim(obj.PNPDeviceID))
    rpm = obj.SpindleSpeed

    ' USB/外付けディスクをスキップ
    If iface = "usb" Or _
       InStr(media, "removable") > 0 Or _
       InStr(media, "external") > 0 Or _
       InStr(model, "card reader") > 0 Or _
       InStr(pnpid, "usb") > 0 Then
      ' スキップ
    Else
      ' 容量と標準サイズに丸める
      If IsNumeric(size) Then
        sizeGB = Round(CDbl(size) / 1073741824, 1)
        stdSize = RoundToStandardSize(sizeGB)
      Else
        sizeGB = "不明"
        stdSize = "不明"
      End If

      ' 種別判定（NVMe / SATA SSD / HDD / 不明）
      If InStr(model, "nvme") > 0 Or InStr(model, "kbg") > 0 Or InStr(model, "mzvl") > 0 Then
        devtype = "NVMe SSD"
      ElseIf InStr(model, "ssd") > 0 Then
        devtype = "SSD"
      ElseIf iface = "sata" Or iface = "ide" Then
        If rpm = "" Or rpm = 0 Then
          devtype = "SSD" ' 回転数がなければSSDと判定
        Else
          devtype = "HDD"
        End If
      ElseIf InStr(model, "st") > 0 Or InStr(model, "hdd") > 0 Then
        devtype = "HDD"
      Else
        devtype = "不明"
      End If

      If results <> "" Then results = results & vbCrLf

      ' 100GB未満・4TB超は [ ] 表記省略
      If stdSize = "100GB未満" Or stdSize = "4TB超" Then
        results = results & model & "（" & devtype & " " & sizeGB & "GB）"
      Else
        results = results & model & "（" & devtype & " " & stdSize & " [" & sizeGB & "GB]）"
      End If
    End If
  Next

  If results = "" Then
    GetDrive = "ストレージ情報なし"
  Else
    GetDrive = results
  End If
End Function

Function GetODD()
  Dim it, result
  result = ""

  For Each it In WMIC("\\.\root\cimv2", "Select Name from Win32_CDROMDrive")
    If Trim(it.Name) <> "" Then
      If result = "" Then
        result = it.Name
      Else
        result = result & vbCrLf & it.Name
      End If
    End If
  Next

  If result = "" Then
    GetODD = "無しor欠品"
  Else
    GetODD = result
  End If
End Function

Function GetWiFi()
  Dim it, name
  For Each it In WMIC("\\.\root\cimv2", "Select Name from Win32_NetworkAdapter WHERE PhysicalAdapter=True")
    name = UCase(Trim(it.Name))
    If InStr(name, "WIRELESS") > 0 _
      Or InStr(name, "WIFI") > 0 _
      Or InStr(name, "WI-FI") > 0 _
      Or InStr(name, "802.11") > 0 _
      Or InStr(name, "CENTRINO") > 0 _
      Or InStr(name, "ADVANCED-N") > 0 _
      Or InStr(name, "WLAN") > 0 Then
        GetWiFi = it.Name
        Exit Function
    End If
  Next
  GetWiFi = "無しor不明"
End Function

Function NearInch(v)
  Dim s, i, b, d
  s = Array(10.1,11.6,12.5,13.3,14,15,15.6,16,17,17.3)
  b = s(0) : d = Abs(v - b)
  For i = 1 To UBound(s)
    If Abs(v - s(i)) < d Then d = Abs(v - s(i)) : b = s(i)
  Next
  If (InStr(LCase(GetSystemModel()), "vaio") > 0 Or InStr(LCase(GetSystemModel()), "sony") > 0) And b = 15.6 Then b = 15.5
  NearInch = b
End Function

Function GetDisp()
  Dim wcm, hcm, w, h, inch
  wcm = 0 : hcm = 0
  Dim it

  ' ノートでも一体型でもなければ省略
  If Not IsPortableType() Then
    GetDisp = "（外付けディスプレイのため省略）"
    Exit Function
  End If

  On Error Resume Next
  For Each it In WMIC("\\.\root\wmi", "Select MaxHorizontalImageSize,MaxVerticalImageSize from WmiMonitorBasicDisplayParams")
    wcm = it.MaxHorizontalImageSize
    hcm = it.MaxVerticalImageSize
    Exit For
  Next
  On Error GoTo 0

  If wcm > 0 And hcm > 0 Then
    inch = NearInch(Round(Sqr(wcm * wcm + hcm * hcm) / 2.54, 1))
  Else
    inch = 0
  End If

  On Error Resume Next
  For Each it In WMIC("\\.\root\cimv2", "Select CurrentHorizontalResolution,CurrentVerticalResolution from Win32_VideoController")
    w = it.CurrentHorizontalResolution
    h = it.CurrentVerticalResolution
    Exit For
  Next
  On Error GoTo 0

  If inch > 0 Then
    GetDisp = inch & " インチ（" & w & " x " & h & "）"
  ElseIf w > 0 And h > 0 Then
    GetDisp = "取得不可（" & w & " x " & h & "）"
  Else
    GetDisp = "取得不可（解像度不明）"
  End If
End Function

Function GetCam()
  Dim it, name, desc, capt

  If Not IsPortableType() Then
    GetCam = "（外付けディスプレイのため省略）"
    Exit Function
  End If

  ' Name / Description / Caption のいずれかに "webcam" または "camera" を含むかチェック
  For Each it In WMIC("\\.\root\cimv2", "Select Name, Description, Caption from Win32_PnPEntity")
    name = LCase(Trim(Safe(it.Name)))
    desc = LCase(Trim(Safe(it.Description)))
    capt = LCase(Trim(Safe(it.Caption)))

    If InStr(name, "webcam") > 0 Or InStr(name, "camera") > 0 Then
      GetCam = it.Name
      Exit Function
    End If

    If InStr(desc, "webcam") > 0 Or InStr(desc, "camera") > 0 Then
      GetCam = it.Description
      Exit Function
    End If

    If InStr(capt, "webcam") > 0 Or InStr(capt, "camera") > 0 Then
      GetCam = it.Caption
      Exit Function
    End If
  Next

  GetCam = "無しor不明"
End Function

Function GetOS()
  Dim shell, fso, d, caption, originalCaption, arch, build, path, found
  Set shell = CreateObject("WScript.Shell")
  Set fso = CreateObject("Scripting.FileSystemObject")
  found = False

  ' WinPEか判定（X:ならWinPE）
  If UCase(shell.ExpandEnvironmentStrings("%SystemDrive%")) = "X:" Then
    For Each d In fso.Drives
      If d.IsReady And d.DriveLetter <> "X" And (d.DriveType = 2 Or d.DriveType = 3) Then
        path = d.DriveLetter & ":\Windows\System32\config\SOFTWARE"
        If fso.FileExists(path) Then
          shell.Run "reg load HKLM\TempSoft """ & path & """", 0, True
          On Error Resume Next
          originalCaption = shell.RegRead("HKLM\TempSoft\Microsoft\Windows NT\CurrentVersion\ProductName")
          arch            = shell.RegRead("HKLM\TempSoft\Microsoft\Windows NT\CurrentVersion\BuildLabEx")
          build           = shell.RegRead("HKLM\TempSoft\Microsoft\Windows NT\CurrentVersion\CurrentBuild")
          shell.Run "reg unload HKLM\TempSoft", 0, True
          On Error GoTo 0

          If originalCaption <> "" Then
            caption = originalCaption
            If build <> "" And IsNumeric(build) Then
              If CLng(build) >= 22000 And InStr(originalCaption, "Windows 10") > 0 Then
                caption = Replace(originalCaption, "Windows 10", "Windows 11")
              End If
            End If

            If InStr(arch, "amd64") > 0 Then
              arch = "64 ビット"
            ElseIf InStr(arch, "x86") > 0 Then
              arch = "32 ビット"
            Else
              arch = "ビット数不明"
            End If

            GetOS = caption & "（" & arch & "）"
            found = True
            Exit For
          End If
        End If
      End If
    Next
    If Not found Then GetOS = "OSなし"
  Else
    ' 通常起動
    Dim it
    For Each it In WMIC("\\.\root\cimv2", "Select Caption,OSArchitecture,BuildNumber from Win32_OperatingSystem")
      caption = it.Caption
      If CLng(it.BuildNumber) >= 22000 And InStr(caption, "Windows 10") > 0 Then
        caption = Replace(caption, "Windows 10", "Windows 11")
      End If
      GetOS = caption & "（" & Replace(it.OSArchitecture, "-bit", " ビット") & "）"
      Exit Function
    Next
    GetOS = "不明"
  End If
End Function

Function FormatOS(caption, arch)
  If InStr(arch, "amd64") > 0 Then
    arch = "64 ビット"
  ElseIf InStr(arch, "x86") > 0 Then
    arch = "32 ビット"
  Else
    arch = "ビット数不明"
  End If
  FormatOS = caption & "（" & arch & "）"
End Function

Sub WriteTextFile(path, content)
  Dim f : Set f = CreateObject("Scripting.FileSystemObject").CreateTextFile(path, True)
  f.Write content
  f.Close
End Sub

Function GetBat()
  On Error Resume Next
  Dim design, full, objWMIService, colItems, obj

  Set objWMIService = GetObject("winmgmts:\\.\root\wmi")

  ' 現在値の取得
  Set colItems = objWMIService.ExecQuery("Select * from BatteryFullChargedCapacity")
  For Each obj In colItems
    full = obj.FullChargedCapacity
    Exit For
  Next

  ' 設計値の取得
  Set colItems = objWMIService.ExecQuery("Select * from BatteryStaticData")
  For Each obj In colItems
    design = obj.DesignedCapacity
    Exit For
  Next

  If IsEmpty(design) Or IsEmpty(full) Or Not IsNumeric(design) Or Not IsNumeric(full) Then
    GetBat = "無しor不明"
  Else
    Dim rate
    rate = Round((design - full) / design * 100)
    GetBat = "設計値: " & design & " / 現在値: " & full & "（劣化 " & rate & " %）"
  End If
End Function

Function GetKB()
  Dim r
  For Each r In Document.getElementsByName("kb")
    If r.Checked Then GetKB = r.Value : Exit Function
  Next
  GetKB = ""
End Function

Function RoundToStandardSize(sizeGB)
  Dim realByte, decimalGB, closest, diff, i
  Dim candidates, candidate

  ' 実効GB → Byte → 10進GB
  realByte = sizeGB * 1073741824 ' = 1024^3
  decimalGB = realByte / 1000000000

  ' 候補リスト（必要に応じて増やせます）
  candidates = Array(120,128,160,180,200,220,240,250,256,275,300,320,350,375,400,440,460,480,500,512,525,560,600,640,750,800,900,960,1000,1024,1200,1280,1500,1600,1800,2000,2048,2500,3000,3072,4000)

  closest = "不明"
  diff = 999999

  For Each candidate In candidates
    If Abs(candidate - decimalGB) < diff Then
      diff = Abs(candidate - decimalGB)
      closest = candidate & "GB"
    End If
  Next

  RoundToStandardSize = closest
End Function

Sub SaveButton()
  Dim tbl, row, fso, f, path, rawPath
  Dim makerModel, serial, namePart

  ' 表にキーボード行を追加
  Set tbl = Document.getElementById("specBody")
  Set row = tbl.insertRow()
  row.insertCell().innerText = "キーボード"
  row.insertCell().innerText = GetKB()

  Document.getElementById("kbGroup").style.display = "none"
  Document.getElementById("controls").style.display = "none"

  ' --- 表から「メーカー・型番」を取得 ---
  makerModel = ""
  For Each row In tbl.rows
    If row.cells(0).innerText = "メーカー・型番" Then
      makerModel = Trim(row.cells(1).innerText)
      Exit For
    End If
  Next

  ' --- BIOSからシリアル番号を取得（表示には使わない） ---
  serial = GetSerial()

  ' --- ファイル名用の整形 ---
  namePart = makerModel & "_" & Right(serial, 20)
  namePart = Replace(namePart, " ", "_")
  namePart = Replace(namePart, "\", "_")
  namePart = Replace(namePart, "/", "_")
  namePart = Replace(namePart, ":", "_")

  ' --- 保存先パスの構築 ---
  Set fso = CreateObject("Scripting.FileSystemObject")
  rawPath = document.location.pathname
  If Left(rawPath, 8) = "file:///" Then rawPath = Mid(rawPath, 9)
  rawPath = Replace(rawPath, "/", "\")
  If Left(rawPath, 1) = "\" Then rawPath = Mid(rawPath, 2)

  path = fso.GetParentFolderName(rawPath) & "\pc_spec_" & namePart & ".txt"

  ' --- ファイルへの書き出し ---
  Set f = fso.CreateTextFile(path, True)
  For Each row In tbl.rows
    If row.rowIndex > 0 Then
      f.WriteLine row.cells(0).innerText & "：" & row.cells(1).innerText
    End If
  Next
  f.Close

  ' 描画完了後にリサイズ（少し待つ）
  window.setTimeout "AdjustSize", 100
End Sub

Sub Document_OnKeyDown()
  Select Case window.event.keyCode

    Case 13  ' Enterキー
      Dim tbl, lastRow
      Set tbl = Document.getElementById("specBody")
      Set lastRow = tbl.rows(tbl.rows.length - 1)

      ' 最後の行が「キーボード」の場合はEnter無効
      If lastRow.cells(0).innerText <> "キーボード" Then
        If Not Document.getElementById("saveBtn").disabled Then
          window.event.returnValue = False ' デフォルト動作キャンセル
          Document.getElementById("saveBtn").click
        End If
      End If

    Case 27  ' ESCキー
      Document.getElementById("kbGroup").style.display = ""
      Document.getElementById("controls").style.display = ""

      Set tbl = Document.getElementById("specBody")
      Set lastRow = tbl.rows(tbl.rows.length - 1)
      If lastRow.cells(0).innerText = "キーボード" Then
        tbl.deleteRow tbl.rows.length - 1
      End If

      Call AdjustSize

  End Select
End Sub

Sub Window_OnLoad()
  InitSpecTable
  LoadSpec
  window.setTimeout "RemoveSkippedRows", 550  ' LoadSpec完了後に省略行削除
  window.setTimeout "AdjustSize", 600         ' 削除後にサイズ再調整
End Sub

'=== 画面サイズを調整 ===
Sub AdjustSize()
  Dim w, h
  w = Document.getElementById("wrapper").offsetWidth + 40   ' 左右余白分
  h = Document.getElementById("wrapper").offsetHeight + 60  ' 上下余白分

  ' 幅の上限（必須）
  If w > 760 Then w = 760

  window.resizeTo w, h
End Sub

Sub EnableSave()
  Document.getElementById("saveBtn").disabled = False
End Sub

Sub RemoveSkippedRows()
  Dim tbl, i, label
  Set tbl = Document.getElementById("specBody")

  ' 後ろから順にチェック（削除しても index がズレないようにする）
  For i = tbl.rows.length - 1 To 0 Step -1
    label = tbl.rows(i).cells(1).innerText
    If InStr(label, "省略") > 0 Then
      tbl.deleteRow i
    End If
  Next
End Sub

</script>
</head>
<body>
<div id="wrapper">

  <table>
    <colgroup>
      <col style="width: 20%">
      <col style="width: 80%">
    </colgroup>
    <thead>
      <tr><th>項目名</th><th>表示内容</th></tr>
    </thead>
    <tbody id="specBody">
      <!-- AddRow によってデータ行が追加される -->
    </tbody>
  </table>

  <div class="inline-group" id="kbGroup" style="margin-top:8px">
    <div style="font-size:13px;color:#666;margin-bottom:4px;">
    ※キーボードの状態を選択すると「保存する」ボタンが有効になります。
    </div>
    キーボード：
      <label><input type="radio" name="kb" value="正常" accesskey="Z" onclick="EnableSave()"> 正常(Z)</label>
      <label><input type="radio" name="kb" value="不良" accesskey="X" onclick="EnableSave()"> 不良(X)</label>
      <label><input type="radio" name="kb" value="なし"  accesskey="C" onclick="EnableSave()"> なし(C)</label>
  </div>

  <div id="controls">
    <div class="inline-group">
      <button id="saveBtn" accesskey="S" onclick="VBScript:SaveButton" disabled>保存する(S)</button>
    </div>
  </div>

</div>
</body>
</html>

      注意事項・免責について

      本ツールはVBScriptとWMICを利用して簡易的にスペック情報を取得するものであり、すべての機種・構成において正確な情報取得を保証するものではありません。

      一部機種では、パーツ構成や管理方法の違いにより、「不明」や誤った情報が表示される場合があります。

      特にメモリやストレージ、Webカメラなどの項目で誤検出が起きる可能性があります。

      実際の情報との照合や、必要に応じた再確認・カスタマイズを行ったうえでご利用ください。

      本ツールの使用に伴って生じた不具合や損害について、筆者は一切の責任を負いかねます。

      ご自身の責任にてご活用ください。

      まとめ

      この記事では、VBScript＋HTAを使ったPCスペック表示ツールの特徴や使い方について解説しました。

      このツールは、次のような場面で特に役立ちます。

      • フリマ出品前のスペック確認
      • Windowsが起動しないPCの診断（WinPE環境）
      • 出荷前の検品記録の保存
      • 現地での簡易チェック（USBメモリで持ち運び可）

      インストール不要・軽量設計で、通常のWindows環境はもちろん、WinPEなどの一時起動環境でも手軽に動作します。

      また、キーボード状態の記録や、メーカー・型番・シリアルを含んだ自動ファイル名の保存機能により、複数台のパソコンを扱う作業でも管理がしやすくなります。

      今後はより拡張性の高い PowerShell＋HTA構成の後継版 も別記事にて紹介予定です。

      -動作確認