{quote}{login=ancheville}{date=17.05.2010 11:36}{thema=Как защитить книгу Excel?}{post}Подскажите пожалуйста, можно ли в VBA (Excel) написать какую-то функцию, которая проверяла бы, например, номер процессора или еще какой-то уникальный параметр и, если он не совпадает с допустимым диапазоном, то книга не запускалась бы.{/post}{/quote}  
есть пример с ip , есть с мас адресом сетевой карты, есть с кодом раздела  
вам что по душе?

Sub SpecificationsProcessor()  
Dim strComputer As String  
Dim objWMIService As Object, colProcessor As Object, objProcessor As Object  
strComputer = "."  
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")  
Set colProcessor = objWMIService.ExecQuery("SELECT * FROM Win32_Processor")  
For Each objProcessor In colProcessor  
Debug.Print "ProcessorId: " & objProcessor.ProcessorId  
MsgBox "ProcessorId: " & objProcessor.ProcessorId  
Next  
End Sub

А можно определять серийный номер диска С  
 
Sub GetDrvSerialNumber()  
  'Определяем номер серийного диска С на вашем компьютере  
  MsgBox Hex$(CreateObject("Scripting.FileSystemObject").GetDrive("C").SerialNumber)  
End Sub  
     
 
  допустим он будет BE164BD1  
  тогда можно написать такой код и поместить его в модуль ЭтаКнига (ThisWorkbook)  
 
Private Sub Workbook_Open()  
  If Hex$(CreateObject("Scripting.FileSystemObject").GetDrive("C").SerialNumber) <> BE164BD1 Then  
     ThisWorkbook.Close False  
  End If  
End Sub

{quote}{login=ancheville}{date=17.05.2010 11:36}{thema=Как защитить книгу Excel?}{post}Подскажите пожалуйста, можно ли в VBA (Excel) написать какую-то функцию, которая проверяла бы, например, номер процессора или еще какой-то уникальный параметр и, если он не совпадает с допустимым диапазоном, то книга не запускалась бы.{/post}{/quote}  
 
Sub Test()  
   Dim wsh As Object  
   Dim RegEx As Object, RegM As Object  
   Dim FSO As Object, fil As Object  
   Dim ts As Object, txtAll As String, TempFil As String  
   Set wsh = CreateObject("WScript.Shell")  
   Set FSO = CreateObject("Scripting.FileSystemObject")  
   Set RegEx = CreateObject("vbscript.regexp")  
   TempFil = "C:\myip.txt"  
 
   wsh.Run "%comspec% /c ipconfig > " & TempFil, 0, True  
   With RegEx  
       .Pattern = "(\d{1,3}\.){3}\d{1,3}"  
       .Global = False  
   End With  
   Set fil = FSO.GetFile(TempFil)  
 
   Set ts = fil.OpenAsTextStream(1)  
   txtAll = ts.ReadAll  
   Set RegM = RegEx.Execute(txtAll)  
 
   ActiveSheet.Range("A1").Value = RegM(0)  
   ActiveSheet.Range("A1").EntireColumn.AutoFit  
   ts.Close  
 
   Kill TempFil  
       
   Set ts = Nothing  
   Set wsh = Nothing  
   Set fil = Nothing  
   Set FSO = Nothing  
   Set RegM = Nothing  
   Set RegEx = Nothing  
End Sub

{quote}{login=}{date=17.05.2010 11:52}{thema=}{post}А можно определять серийный номер диска С  
 
Sub GetDrvSerialNumber()  
  'Определяем номер серийного диска С на вашем компьютере  
  MsgBox Hex$(CreateObject("Scripting.FileSystemObject").GetDrive("C").SerialNumber)  
End Sub  
     
 
  допустим он будет BE164BD1  
  тогда можно написать такой код и поместить его в модуль ЭтаКнига (ThisWorkbook)  
 
Private Sub Workbook_Open()  
  If Hex$(CreateObject("Scripting.FileSystemObject").GetDrive("C").SerialNumber) <> BE164BD1 Then  
     ThisWorkbook.Close False  
  End If  
End Sub{/post}{/quote}  
 
<лагодарю за быстры ответ по теме!

У меня "дву-ядрёный" - оба показывает. Может быть влияет 64/32? У меня 32-битная.

{quote}{login=KuklP}{date=18.05.2010 12:05}{thema=}{post}R Dmitry, Юрий М, может отправляйте автора... Иначе планета преврратится в форум вирусописателей. ИМХО.{/post}{/quote}  
топикстарт Вы вирусы писать не будете?

Топикстартер - это я?

А так?  
Sub Test()  
Dim Computer As String  
Dim WMI As Variant  
Dim Items As Variant  
Dim Item As Variant  
Computer = "."  
Set WMI = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2")  
Set Items = WMI.ExecQuery("Select * from Win32_Processor")  
For Each Item In Items  
Debug.Print Item.ProcessorId  
MsgBox Item.ProcessorId  
Next  
End Sub

Вот этот код тоже почти пустое сообщение создаёт  
 
Sub Example_3()  
Dim objCollection As Object, objWMI As Object, objItem As Object  
   Set objWMI = GetObject("winmgmts:\\.\root\CIMV2")  
   Set objCollection = objWMI.ExecQuery("select * from Win32_Processor")  
   For Each objItem In objCollection  
       MsgBox "Caption: " & objItem.Caption & vbCrLf & _  
           "Name: " & objItem.Name & vbCrLf & _  
           "ProcessorId: " & objItem.ProcessorId & vbCrLf & _  
           "ProcessorType: " & objItem.ProcessorType & vbCrLf & _  
           "Revision: " & objItem.Revision & vbCrLf & _  
           "Version: " & objItem.Version & vbCrLf & vbCrLf & _  
           "SystemName: " & objItem.SystemName  
           Exit For  
   Next  
End Sub  
 
Есть только Caption, Name и System Name

Ну, фиг с ним ) Мы дали топикстартеру идея для размышления )

Вот что написал    
 
NUMBER_OF_PROCESSORS=4  
OS=Windows_NT  
PROCESSOR_ARCHITECTURE=x86  
PROCESSOR_IDENTIFIER=x86 Family 6 Model 23 Stepping 10, GenuineIntel  
PROCESSOR_LEVEL=6  
PROCESSOR_REVISION=170a  
 
 
P.S. У меня проц "Intel® Core™2 Quad CPU  Q9650  @ 3.00GHz"  
Windows 7

Намекает, наверное, что могёт и с 64 работать

Защитить проект, наверное? Правый клик на проекте - Свойства - Закладка Защита.