保护excel的方法vba硬盘序列号

Question

我的 vba 代码是

Public Function notHDD()

Dim m As String
Const test = "WD-WX22AAAAAA"

m = GetHDD

If m <> test Then
    notHDD = True
Else
    notHDD = False
End If

End Function

Function GetHDD() As String
    Dim Wmi As Object, Disks As Object, Disk As Object
    Set Wmi = GetObject("winmgmts:{impersonationLevel" & "=impersonate}!root\cimv2")
    Set Disks = Wmi.ExecQuery("Select * from Win32_DiskDrive")
    For Each Disk In Disks
    If Len(Disk.SerialNumber) > Len(GetSerialNumber) Then GetSerialNumber = Disk.SerialNumber
    Next
    Set Disk = Nothing
    Set Disks = Nothing
    Set Wmi = Nothing
GetHDD = GetSerialNumber
End Function


Private Sub Workbook_Open()

If notHDD Then
    ThisWorkbook.Close
End If

End Sub

为什么这段代码不起作用？

我只想要此操作系统硬盘序列号 WD-WX22AAAAAA 上的 Excel 文件

在除此之外的系统上关闭

Answer 1

在 DOS 提示符 cscript -nologo WMIC_DiskDrive.vbs 中运行此脚本。它是否打印出磁盘序列号（应该）？类似的代码应该在 Excel VBA 脚本宏中工作。

' Look disks
' cscript -nologo scriptname.vbs
Option Explicit

Dim StdOut: Set StdOut = WScript.StdOut

Dim oWmi: Set oWmi    = GetObject("winMgmts:{impersonationLevel=impersonate}!\\.\Root\CIMv2")
Dim oDisks: Set oDisks= oWmi.ExecQuery("Select * from Win32_DiskDrive")
Dim idx
Dim oItem

for idx=0 to oDisks.count-1
  Set oItem = oDisks.ItemIndex(idx)
  StdOut.writeLine(idx & "=" & oItem.SerialNumber)
next

这是 Excel VBA 测试宏，它会打印出磁盘序列吗？将值与您的预定义变量进行比较。序列号可能有空格字母。

Public Sub DiskDrives()
    Dim ws As Worksheet
    Dim oWmi As Object
    Dim oDisks As Object
    Dim oItem As Object
    Dim idx As Long
    
    Set ws = Application.ActiveSheet
    
    Set oWmi = GetObject("winMgmts:{impersonationLevel=impersonate}!\\.\Root\CIMv2")
    Set oDisks = oWmi.ExecQuery("Select * from Win32_DiskDrive")
    For idx = 0 To oDisks.Count - 1
        Set oItem = oDisks.ItemIndex(idx)
        Debug.Print ("|" & idx & "=" & oItem.SerialNumber & "|")
        ws.Cells(4 + idx, 1).Value = "Disk " & idx
        ws.Cells(4 + idx, 2).Value = "|" & oItem.SerialNumber & "|"
    Next
End Sub