PCのメーカー・モデル（製品名）を取得するVBA

どうも、HALUです。

僕が管理しているVBA初心者のオープンチャットに、こんなような相談がありました。

「ＰＣの情報が取得したくて、色々ネットを探したがメーカー＆製品名をＶＢＡで自動で取得する方法が見つからない」

自分も少し探しましたが、手動だとwindowsならコントロールパネルの中のシステムから見つけることは出来ますが自動でVBAで取る方法は見つかりませんでした。

・・・じゃあ作りましょう！
ということでVBAで書いてみました。僕も基本的にはネットで使えそうなコード探して真似るのですが、今回はちょっと考えました。方法としてはコマンドプロンプトでsysteminfoと打った結果の中にそれらの情報が入っていることをヒントに、

１．VBAからバッチファイルを呼び出し
２．バッチファイル内の処理でsysteminfoを実行し、その結果をテキストファイルに出力
３．VBAで結果が入ったテキストファイルを読み込み、必要な情報だけを取得

の3段階で何とか自動化しました。

以下、コードです。

Sub get_systeminfo()

   Dim objFso As Object        ' ファイルシステムオブジェクト
   Dim obj As WshShell         ' shellオブジェクト
   Dim strBatPath As String    ' バッチファイルパス
   Dim buf As String           ' ファイル読み込み時のバッファ
   Dim ii As Long              ' カウント変数
   Dim jj As Long              ' カウント変数
   Dim arrayTxt() As String    ' システム情報の配列
   Dim strMaker As String      ' PCのメーカー名
   Dim strModel As String      ' PCのモデル名

   '-----------------------------------------------------
   ' バッチファイルを作成
   '-----------------------------------------------------
   '----------- オブジェクトを宣言
   Set objFso = CreateObject("Scripting.FileSystemObject")
   
   '----------- ファイルパスを設定
   strBatPath = ThisWorkbook.Path & "\getinfo.bat"
   
   '----------- バッチファイルを作成
   With objFso
       If Not .FileExists(strBatPath) Then
           .CreateTextFile (strBatPath)
       End If
   End With
   
   '----------- オブジェクトを初期化
   Set objFso = Nothing
   
   '----------- バッチファイルを開く
   Open strBatPath For Output As #1
       '----------- バッチファイルにコードを書き込み
       Print #1, "SET BAT_DIR=%~dp0"
       Print #1, "cd /d %~dp0"
       Print #1, "systeminfo>pcinfomation.txt"
       
   '----------- ファイルを閉じる
   Close #1
   
   '-----------------------------------------------------
   ' バッチファイルを実行
   '-----------------------------------------------------
   '----------- バッチ実行
   Set obj = New WshShell
   Call obj.Run(strBatPath, WaitOnReturn:=True)
   
   '-----------------------------------------------------
   ' システム情報の結果ファイルからデータを取得
   '-----------------------------------------------------
   '----------- 行数を初期化
   jj = 0
   '----------- ファイルを開く
   Open ThisWorkbook.Path & "\pcinfomation.txt" For Input As #1
       Do Until EOF(1)
           Line Input #1, buf
           '----------- 配列を再宣言
           ReDim Preserve arrayTxt(jj)
           '----------- 配列にバッファを格納
           arrayTxt(jj) = buf
           '----------- 行数をカウント
           jj = jj + 1
       Loop
   Close #1
   
   '-----------------------------------------------------
   ' 全データから欲しい情報のみ取り出す
   '-----------------------------------------------------
   '----------- 配列の大きさだけループ
   For ii = 0 To UBound(arrayTxt)
       '----------- データの中に"システム製造元:"の文字があった時
       If InStr(arrayTxt(ii), "システム製造元:") > 0 Then
           '----------- 中身を取得
           strMaker = Replace(arrayTxt(ii), "システム製造元:", "")
       End If
       '----------- データの中に"システム モデル:"の文字があった時
       If InStr(arrayTxt(ii), "システム モデル:") > 0 Then
           '----------- 中身を取得
           strModel = Replace(arrayTxt(ii), "システム モデル:", "")
       End If
   Next
   
   '----------- 結果をセルに出力
   ThisWorkbook.Worksheets("sheet1").Range("B1") = LTrim(strMaker)
   ThisWorkbook.Worksheets("sheet1").Range("B2") = LTrim(strModel)
   
End Sub

上記のコードを丸々マクロの標準モジュールのところにコピペして実行したら、バッチファイルの作成もその実行も結果の取得も全部やってくれます

今回は出力先を適当にB1とB2にしましたが、ここを自由に変えてやれば好きなところに出力出来るかなと思います。

また、バッチファイルやらＰＣ情報が入ったテキストファイルはマクロを置いたフォルダと同じところに作られるようになっています。

コード内の処理で詳しい説明が必要であれば、ここのコメントかオープンチャットの方でまた質問してください。軽く補足します。