保护Excel的方法vba硬盘序列号 [英] Protect excel Of the method vba hard drive serial number

问题描述

我的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

为什么此代码不起作用?

Why does this code not work?

我只希望在此操作系统硬盘串行WD-WX22AAAAAA上使用Excel文件

I want Excel file only on this operating system HDD serial WD-WX22AAAAAA

在除此以外的系统上关闭

Close on systems other than this

推荐答案

在DOS提示符cscript -nologo WMIC_DiskDrive.vbs中运行此脚本.是否打印出磁盘序列号(应该)?类似的代码应在Excel VBA脚本宏中起作用.

Run this script in a DOS prompt cscript -nologo WMIC_DiskDrive.vbs. Does it print out disk serial numbers (it should)? Similar code should work in Excel VBA script macros.

' 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测试宏，它可以打印出磁盘序列吗?将值与您的预定义变量进行比较.序列号可能包含空格字母.

This is Excel VBA test macro, does it print out disk serials? Compare values to your predefined variable. Serial may have a whitespace letters.

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

这篇关于保护Excel的方法vba硬盘序列号的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！