磐石加密狗

⑴ 我现有一个EXCEL表格文档，如何制作一个加密狗，让别人有了加密码狗才可以使用并修改数据

Private Sub Workbook_Open()
Dim fs, d, s$
On Error Resume Next
For i = 3 To 26
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(Chr(64 + i) & ":")
s = d.serialnumber
Select Case s
Case "1222130052" 'U盘序列号
Exit Sub
End Select
Next i
MsgBox "找不到U盘，系统将退出。"
ThisWorkbook.Close False
End Sub

那么又如何快速得到自己电脑的硬盘的序列号呀？如何快速得到自己U盘的序列号？
Sub sn()

Dim fs, d, s
On Error Resume Next
For i = 3 To 26
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(Chr(64 + i) & ":")
Cells(i, 1) = Chr(64 + i) & ": " & d.serialnumber
Next i