Ｐａｇｅ 59 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼PCのスペック表 TA 02/9/4(水) 20:04 ┣Re:PCのスペック表 こうちゃん 02/9/6(金) 9:49 ┃ ┗Re:PCのスペック表 TA 02/9/6(金) 10:16 ┃ ┣Re:PCのスペック表 こうちゃん 02/9/6(金) 13:53 ┃ ┃ ┗Re:PCのスペック表 TA 02/9/6(金) 22:36 ┃ ┗Re:PCのスペック表 JuJu 02/9/6(金) 18:39 ┃ ┣Re:PCのスペック表 TA 02/9/6(金) 22:39 ┃ ┗Re:PCのスペック表 TA 02/9/10(火) 12:33 ┃ ┗Re:PCのスペック表 JuJu 02/9/10(火) 17:42 ┗Re:PCのスペック表 TA 02/9/7(土) 14:47 ┗Re:PCのスペック表 禰宜 02/9/8(日) 15:01 ─────────────────────────────────────── ■題名 ： PCのスペック表 ■名前 ： TA <takashi.aw@comeon.cx> ■日付 ： 02/9/4(水) 20:04 -------------------------------------------------------------------------
| PCのスペック表を作りたいのですが スペックを知りたいＰＣでエクセルファイルを開けば ＠デバイスマネージャーのエクセル版ができてしまう！！ それを作りたいと思っております Excel VBA からCPU などの情報（CPUの種類や速度、ハードディスク名称等など） を取得する方法がわかりません ご協力していただけないでしょうか？ |
| TA さん、こんにちは >PCのスペック表を作りたいのですが >スペックを知りたいＰＣでエクセルファイルを開けば >＠デバイスマネージャーのエクセル版ができてしまう！！ >それを作りたいと思っております >Excel VBA からCPU などの情報（CPUの種類や速度、ハードディスク名称等など） >を取得する方法がわかりません > >ご協力していただけないでしょうか？ レスがつかないようなので・・・ ご希望の内容が具体的でないのでレスがつけづらいのだと思います。 「何」と「何」が必要なのかおしえてください。 ただし、「＠デバイスマネージャーのエクセル版」だと WindowsのAPI ゴリゴリ使って、一部は自作DLL作って・・・てな感じになるかもしれませんね。 まあ、OSのバージョンだとかドライブの情報なら比較的簡単かもしれませんが・・^^; とりあえず、「ここまで作ったんですが」とか「○○と××」を知る方法はとか、具体的に質問してくださいね。 ＃答えでなくてごめんなさいね。 |
| >とりあえず、「ここまで作ったんですが」とか「○○と××」を知る方法はとか、具体的に質問してくださいね。 わがまま身勝手な質問にお答えいただいてまことに申しえ分けありません ここまで・・・ なんですが 簡単にいうと セルにデバイスマネージャーの各機器情報を取り入れたいのです 呼び出すコマンドが一切不明な状況です お助けのほうをよろしくお願いいたします |
| TA さん、こんにちは >>とりあえず、「ここまで作ったんですが」とか「○○と××」を知る方法はとか、具体的に質問してくださいね。 具体的にお願いします。どこから手をつけていいかわからない状態なら、例をあげて質問するといいですね。 例えばA列にドライブ名を、B列に容量を列挙したいとか・・ あと、この手の質問はプラットフォームが重要な場合がありますので、環境（OSやExcelのバージョン等）を明確にしましょう。 >簡単にいうと >セルにデバイスマネージャーの各機器情報を取り入れたいのです >呼び出すコマンドが一切不明な状況です 簡単に言われちゃわかりません^^: 知識不足でもうしわけないですが、デバイスマネージャーとはなんですか？ とはいえ、とりあえずTAさんの要望がわかりませんので、とっかかりとして・・ PCのすべてのドライブのタイプとハードディスクの容量をFSOで調べるサンプル上げときます。 標準モジュールで実行してみてください。 Sub test() Dim d As Variant Dim DType As String Dim DTtl As String Dim DSpc As String Dim fso As Object Dim i As Integer Set fso = CreateObject("Scripting.FilesystemObject") Cells(1, 1).Value = "ドライブ文字" Cells(1, 2).Value = "ドライブタイプ" Cells(1, 3).Value = "総容量" Cells(1, 4).Value = "空き容量" i = 1 For Each d In fso.Drives DTtl = "" DSpc = "" Select Case d.Drivetype Case 0: DType = "不明" Case 1: DType = "リムーバブルディスク" Case 2 DType = "ハードディスク" DTtl = Format(d.TotalSize / (1024# * 1024#), "#.#") & "MB" DSpc = Format(d.AvailableSpace / (1024# * 1024#), "#.#") & "MB" Case 3: DType = "ネットワークドライブ" Case 4: DType = "CD-ROM" Case 5: DType = "RAMディスク" End Select i = i + 1 Cells(i, 1).Value = d.DriveLetter Cells(i, 2).Value = DType Cells(i, 3).Value = DTtl Cells(i, 4).Value = DSpc Next MsgBox i - 1 & "個のドライブが見つかりました" End Sub |
| 丁寧なご回答ありがとうございます だんだんと煮詰まってきた感じがします（泣） >例えばA列にドライブ名を、B列に容量を列挙したいとか・・ そうなんですこんな感じで・・・・ >あと、この手の質問はプラットフォームが重要な場合がありますので、環境（OSやExcelのバージョン等）を明確にしましょう。 OSについては2000,XP エクセルでは2000,2002 で実行できるようにしたいのですが ここをみてください ↓ http://afinsuper.hoops.jp/ee/vba.stm これで結構わかっていただけると思います よろしくお願いいたします |
| TAさん、こうちゃん、こんにちはぁ >セルにデバイスマネージャーの各機器情報を取り入れたいのです >呼び出すコマンドが一切不明な状況です デバイスマネージャの情報ならレジストリから抜き出せると思ったのですが、 95系(95,98,Me)では有効になっているデバイスの取得がうまくいかないです。 もう少し考えてみます。 ではではぁ '---- 8= ---- 8< ---- 8= ---- 8< ---- 8= ---- 8< ---- 8= ---- 8< ---- 8= ' レジストリ関連ＡＰＩ定義 Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Const HKEY_CLASSES_ROOT = &H80000000 Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Const KEY_QUERY_VALUE = &H1 Private Const KEY_ENUMERATE_SUB_KEYS = &H8 Private Const REG_SZ = 1 Private Const REG_EXPAND_SZ = 2 ' レジストリから、キー値を取得する Public Function GetRegValue(ByVal hKey As Long, ByVal strSubKey As String, ByVal strValueName As String) As String Dim hReg As Long Dim lngSize As Long Dim lngType As Long Dim lngPos1 As Long, lngPos2 As Long Dim strFuncResult As String strFuncResult = "" '' レジストリを開く If RegOpenKeyEx(hKey, strSubKey, 0&, KEY_QUERY_VALUE, hReg) = 0& Then '' サイズ，型の取得 If RegQueryValueEx(hReg, strValueName, 0&, lngType, ByVal 0&, lngSize) = 0& Then If lngSize > 0 Then '' キー値用のバッファ strFuncResult = Space$(lngSize - 1) '' レジストリ値の取得 If RegQueryValueEx(hReg, strValueName, 0&, lngType, ByVal strFuncResult, lngSize) = 0& Then If lngType = REG_EXPAND_SZ Then '' 環境変数を展開する Do While strFuncResult Like "*%*%*" lngPos1 = InStr(strFuncResult, "%") lngPos2 = InStr(lngPos1 + 1, strFuncResult, "%") strFuncResult = Left$(strFuncResult, lngPos1 - 1) _ & Environ$(Mid$(strFuncResult, lngPos1 + 1, lngPos2 - lngPos1 - 1)) _ & Mid$(strFuncResult, lngPos2 + 1) Loop End If End If End If End If '' レジストリを閉じる RegCloseKey hReg End If GetRegValue = strFuncResult End Function ' レジストリから、サブキーを列挙する Public Function GetRegEnumKey(ByVal hKey As Long, ByVal strSubKey As String) As Variant Dim hReg As Long Dim strRegKey As String, lngRegSize As Long Dim lngIndex As Long Dim udtFileTime As FILETIME Dim astrFuncResult() As String '' レジストリを開く If RegOpenKeyEx(hKey, strSubKey, 0&, KEY_ENUMERATE_SUB_KEYS, hReg) = 0& Then lngIndex = 0 Do '' バッファの初期化 lngRegSize = 256 strRegKey = Space(lngRegSize) '' サブキーの取得 If RegEnumKeyEx(hReg, lngIndex, strRegKey, lngRegSize, 0&, vbNullString, 0&, udtFileTime) <> 0& Then Exit Do ReDim Preserve astrFuncResult(lngIndex) astrFuncResult(lngIndex) = Left$(strRegKey, lngRegSize) lngIndex = lngIndex + 1 Loop '' レジストリを閉じる RegCloseKey hReg End If GetRegEnumKey = IIf(lngIndex > 0, astrFuncResult, Empty) End Function Sub Macro1() Dim strSubKey1 As String, strSubKey2 As String Dim varKeys1 As Variant, varKeys2 As Variant, varKeys3 As Variant Dim i1 As Long, i2 As Long, i3 As Long Dim strDriver As String Dim strDeviceDesc As String Dim strName As String Dim colEnum As New Collection Dim lngRow As Long Dim blnNT As Boolean '' ＯＳの判断 blnNT = Application.OperatingSystem Like "Windows*NT*" If blnNT Then strSubKey1 = "SYSTEM\CurrentControlSet\Enum" strSubKey2 = "SYSTEM\CurrentControlSet\Control\Class" Else strSubKey1 = "Enum" strSubKey2 = "SYSTEM\CurrentControlSet\Services\Class" End If '' 別名一覧の取得 varKeys1 = GetRegEnumKey(HKEY_LOCAL_MACHINE, strSubKey1) If Not IsEmpty(varKeys1) Then For i1 = LBound(varKeys1) To UBound(varKeys1) varKeys2 = GetRegEnumKey(HKEY_LOCAL_MACHINE, strSubKey1 & "\" & varKeys1(i1)) If Not IsEmpty(varKeys2) Then For i2 = LBound(varKeys2) To UBound(varKeys2) varKeys3 = GetRegEnumKey(HKEY_LOCAL_MACHINE, strSubKey1 & "\" & varKeys1(i1) & "\" & varKeys2(i2)) If Not IsEmpty(varKeys3) Then For i3 = LBound(varKeys3) To UBound(varKeys3) If (Len(GetRegValue(HKEY_LOCAL_MACHINE, strSubKey1 & "\" & varKeys1(i1) & "\" & varKeys2(i2) & "\" & varKeys3(i3) & "\Control", "DeviceReference")) > 0) Or Not blnNT Then strDriver = GetRegValue(HKEY_LOCAL_MACHINE, strSubKey1 & "\" & varKeys1(i1) & "\" & varKeys2(i2) & "\" & varKeys3(i3), "Driver") strDeviceDesc = GetRegValue(HKEY_LOCAL_MACHINE, strSubKey1 & "\" & varKeys1(i1) & "\" & varKeys2(i2) & "\" & varKeys3(i3), "DeviceDesc") strName = GetRegValue(HKEY_LOCAL_MACHINE, strSubKey1 & "\" & varKeys1(i1) & "\" & varKeys2(i2) & "\" & varKeys3(i3), "FriendlyName") On Error Resume Next colEnum.Add IIf(Len(strName) > 0, strName, strDeviceDesc), strDriver On Error GoTo 0 End If Next End If Next End If Next End If '' デバイス一覧の取得 lngRow = 1 varKeys1 = GetRegEnumKey(HKEY_LOCAL_MACHINE, strSubKey2) If Not IsEmpty(varKeys1) Then For i1 = LBound(varKeys1) To UBound(varKeys1) strName = GetRegValue(HKEY_LOCAL_MACHINE, strSubKey2 & "\" & varKeys1(i1), "") If Len(strName) > 0 Then ActiveSheet.Cells(lngRow, 1) = strName lngRow = lngRow + 1 varKeys2 = GetRegEnumKey(HKEY_LOCAL_MACHINE, strSubKey2 & "\" & varKeys1(i1)) If Not IsEmpty(varKeys2) Then For i2 = LBound(varKeys2) To UBound(varKeys2) If IsNumeric(varKeys2(i2)) Then '' 別名を取得 strName = "" On Error Resume Next strName = colEnum(varKeys1(i1) & "\" & varKeys2(i2)) On Error GoTo 0 If Len(strName) > 0 Then ActiveSheet.Cells(lngRow, 2) = strName lngRow = lngRow + 1 End If End If Next End If End If Next End If End Sub |
| ご迷惑ばかりおかけしまして 申し訳ありません どうにかなりそうになってきました ここ↓をみてください（わかりにくいかもしれません） http://afinsuper.hoops.jp/ee/vba.stm お手数ですが よろしくお願いいたします |
| 皆様、ご協力いただいてありがとうございます 時間があいてしまいまして大変失礼いたします JuJuさん ありがとうございました JuJuさんのもので各機器の情報は取り出せたのですが 肝心の固有名称って言うやつ・・・・ CPU ならば Pentium 4など 機器型番もＢ列に出力したいのですが・・ ご協力いただけないでしょうか？ |
| TAさん、禰宜さん、こんにちはぁ >肝心の固有名称って言うやつ・・・・ >機器型番もＢ列に出力したいのですが・・ 固有名称？機器型番？ って例えばどんなのですか？ >CPU ならば >Pentium 4など VendorIdentifier と Identifier を表示してみました。 （2000,XP限定） http://www.atmarkit.co.jp/fpc/pcmainterepair/pcmr001/pcmr002.html を参考にしてＣＰＵ名に変換してみてね。 ではではぁ '---- 8= ---- 8< ---- 8= ---- 8< ---- 8= ---- 8< ---- 8= ---- 8< ---- 8= ' レジストリ関連ＡＰＩ定義 Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Const HKEY_CLASSES_ROOT = &H80000000 Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Const KEY_QUERY_VALUE = &H1 Private Const KEY_ENUMERATE_SUB_KEYS = &H8 Private Const REG_SZ = 1 Private Const REG_EXPAND_SZ = 2 Private Const REG_DWORD = 4 ' レジストリから、キー値を取得する Public Function GetRegValue(ByVal hKey As Long, ByVal strSubKey As String, ByVal strValueName As String) As Variant Dim hReg As Long Dim lngSize As Long Dim lngType As Long Dim lngPos1 As Long, lngPos2 As Long Dim strBuffer As String, lngBuffer As Long Dim varFuncResult As Variant varFuncResult = Empty '' レジストリを開く If RegOpenKeyEx(hKey, strSubKey, 0&, KEY_QUERY_VALUE, hReg) = 0& Then '' サイズ，型の取得 If RegQueryValueEx(hReg, strValueName, 0&, lngType, ByVal 0&, lngSize) = 0& Then If lngSize > 0 Then Select Case lngType Case REG_SZ '' キー値用のバッファ strBuffer = Space$(lngSize - 1) '' レジストリ値の取得 If RegQueryValueEx(hReg, strValueName, 0&, lngType, ByVal strBuffer, lngSize) = 0& Then varFuncResult = strBuffer End If Case REG_EXPAND_SZ '' キー値用のバッファ strBuffer = Space$(lngSize - 1) '' レジストリ値の取得 If RegQueryValueEx(hReg, strValueName, 0&, lngType, ByVal strBuffer, lngSize) = 0& Then If lngType = REG_EXPAND_SZ Then '' 環境変数を展開する Do While strBuffer Like "*%*%*" lngPos1 = InStr(strBuffer, "%") lngPos2 = InStr(lngPos1 + 1, strBuffer, "%") strBuffer = Left$(strBuffer, lngPos1 - 1) _ & Environ$(Mid$(strBuffer, lngPos1 + 1, lngPos2 - lngPos1 - 1)) _ & Mid$(strBuffer, lngPos2 + 1) Loop End If varFuncResult = strBuffer End If Case REG_DWORD If RegQueryValueEx(hReg, strValueName, 0&, lngType, lngBuffer, lngSize) = 0& Then varFuncResult = lngBuffer End If End Select End If End If '' レジストリを閉じる RegCloseKey hReg End If GetRegValue = varFuncResult End Function Sub Macro1() ActiveSheet.Cells(1, 1) = GetRegValue(HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\0", "VendorIdentifier") ActiveSheet.Cells(2, 1) = GetRegValue(HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\0", "Identifier") ActiveSheet.Cells(3, 1) = GetRegValue(HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\0", "~MHz") End Sub |
| ▼TA さん： >PCのスペック表を作りたいのですが >スペックを知りたいＰＣでエクセルファイルを開けば >＠デバイスマネージャーのエクセル版ができてしまう！！ >それを作りたいと思っております >Excel VBA からCPU などの情報（CPUの種類や速度、ハードディスク名称等など） >を取得する方法がわかりません > >ご協力していただけないでしょうか？ 引き続きこちらを参照いただきましてご回答のほうを おねがいいたします http://afinsuper.hoops.jp/ee/vba.stm |
| 失礼いたします。 基本的にはレジストリから情報を取得する形になりますよね。 該当するキーから値を取ってきて表示です。 NT系と9X系で微妙に違いはありますが、方法は JuJuさんがご提示のような感じです。 どのあたりが不明点なのでしょうか。 ここまで出来ているという感じのコードがあれば、 アップしてもらえるとレスも付きやすいと思いますよ。 失礼いたしました。 |