VBA获取您的电脑硬件信息

andysky

原帖由 qhllqhll 于 2010-11-4 07:49 发表
老师您好：我试过了
您的代码得到的是C盘号
而前面的很长的代码得到的是 整个硬盘的号
请您在不忙的情况下再帮忙给修改一下此代码
谢谢

Sub 硬盘型号()
Dim 硬盘
Set 硬盘 = GetObject("Winmgmts:").InstancesOf("Win32_DiskDrive")
For Each mo In 硬盘
MsgBox "硬盘型号为:" & mo.Model
Next
End Sub
这段代码是整个硬盘的编号，与C盘无关

andysky

原帖由 qhllqhll 于 2010-11-4 07:10 发表
请老师帮忙 精简以下代码
谢谢
Private Const MAX_IDE_DRIVES As Long = 4   ' Max number of drives assuming primary/secondary, master/slave topology
Private Const READ_ATTRIBUTE_BUFFER_SIZE As Long = 5 ...

这么长的代码其实只用一句代码就可以实现
=GetHardDiskInfo() 用于获取型号/物理系列号（唯一）
下面一句代码同样可以获得
效率高很多

[ 本帖最后由 andysky 于 2010-11-9 09:27 编辑 ]

leroy

对我等计算机菜鸟的帮助太大了！

qhllqhll

好的谢谢
再请教老师一个问题：执行vba代码后，要想撤销！有办法吗？ （代码应怎么写啊）我看查了很多都说没办法，可能是没有此功能吗？
谢谢

[ 本帖最后由 qhllqhll 于 2010-11-8 16:36 编辑 ]

qhllqhll

老师您好：能否把检测硬盘的唯一物理序号和检测优盘的唯一序号（包括多个u盘一起检测出来） 的代码写在一起，让其自动运行而得到检测结果显示存放在工作表的单元格里吗？

gzhppdf

谢天谢地，原来在这里。我找了好几年

qhllqhll

请问老师：下面的代码怎么用啊
Sub auto_open()
MsgBox GetObject("winmgmts:").InstancesOf("Win32_PhysicalMedia")("Win32_PhysicalMedia.Tag=""\\\\.\\PHYSICALDRIVE0""").serialnumber
End Sub

[ 本帖最后由 qhllqhll 于 2010-12-24 07:37 编辑 ]

qhllqhll

请问老师：下面的代码怎么能改成用 “= GetHardDiskInfo()”调用啊？谢谢
Sub 硬盘型号()
Dim 硬盘
Set 硬盘 = GetObject("Winmgmts:").InstancesOf("Win32_DiskDrive")
For Each mo In 硬盘
MsgBox "硬盘型号为:" & mo.Model
Next
End Sub
也就是用于获取的代码加密，
如果....获取的号和预先设置的号相同对..就正常运行本表.....否则就....关闭退出excel工作薄
谢谢老师

[ 本帖最后由 qhllqhll 于 2010-12-24 07:46 编辑 ]

andysky

原帖由 qhllqhll 于 2010-12-24 07:37 发表
请问老师：下面的代码怎么能改成用 “= GetHardDiskInfo()”调用啊？谢谢
Sub 硬盘型号()
Dim 硬盘
Set 硬盘 = GetObject("Winmgmts:").InstancesOf("Win32_DiskDrive")
For Each mo In 硬盘
MsgBox "硬盘型号为 ...

Sub 硬盘型号()
    Dim 硬盘
    Dim STR As String
    Set 硬盘 = GetObject("Winmgmts:").InstancesOf("Win32_DiskDrive")
    For Each mo In 硬盘
        If Len("硬盘型号为:" & mo.Model) > 1 Then
            STR = mo.Model
            Exit For
        End If
    Next
    If STR = "这里写你指定的硬盘型号" Then
        '这里写你的代码
    Else
        ThisWorkbook.Close 0
        Application.Quit
    End If
End Sub

《Excel_2010_VBA编程与实践》PDF下载：
http://u.115.com/file/f633621add#ExcelTipBook3.rar

[ 本帖最后由 andysky 于 2010-12-24 09:50 编辑 ]

可爱天使

好，收下了，谢谢！