ربط فتح ملف الأكسل برقم الهارد

[hanymoaty]

السادة الأفاضل 

الأستاذ الفاضل ،، تحاتي

قمت بإستخراج رقم الهارد في الخلية  A1

عن طريق الكود و المعادبة التالية

Function GetPhysicalSerial() As Variant

Dim obj As Object
Dim WMI As Object
Dim SNList() As String, i As Long, Count As Long
Set WMI = GetObject("WinMgmts:")
For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")
If obj.SerialNumber <> "" Then Count = Count + 1
Next
ReDim SNList(1 To Count, 1 To 1)
i = 1
For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")
SNList(i, 1) = obj.SerialNumber
i = i + 1
If i > Count Then Exit For
Next
GetPhysicalSerial = SNList
End Function

 

ووضع المعادلة الأتية في الخلية A1

 

=GetPhysicalSerial()

 

وبعد ذلك وضعت الكود التالي لربط رقم الهارد بفتح الملف

 

Private Const A As String = "A12533225"
Private Const B As String = "B15223662"
Private Const C As String = "TOSHIBA MK6476GSX"
Private Sub Workbook_Open()
Dim s As String
With GetObject("winmgmts:\\.\root\CIMV2")
For Each itm In .ExecQuery("SELECT * FROM Win32_DiskDrive", , 48)
     s = s & itm.Model
Next itm
End With
If s = A Or s = B Or s = C Then
MsgBox "تم مطابقة الهارد بنجاح ", vbInformation, "تفضل بالدخول"
Else
MsgBox "هذا البرنامج يعمل على أجهزة معينه فقط", vbInformation, "سيتم إغلاق البرنامج"
With ActiveWorkbook
.Close
.Saved = True
End With
Exit Sub
End If
End Sub

 

لكن في كل مره تظهر رسالة ان البرنامج يعمل على اجهزة معينة و معنى ذلك انني افتقد ربط هذا الكود بقراءة رقم الهارد الموجود في الخلية A1

علما بإن الأكواد و المعادلات هى من المشاركة الموجودة من السادة الأفاضل على اللينك الأتي

 

http://www.officena.net/ib/index.php?showtopic=43800

 

ارجوكم الحل بإذن الله