Başka pc de açılmasın

[leumruk]

Merhaba,
Aşağıdaki kodla sürücülerin isimlerini, türlerini ve seri numaralarını öğrenebilirsiniz. Ben USB seri nosunu kullanıyorum. Bir nevi anahtar görevi görüyor ve her bilgisayrada çalışma imkanı var. Tercih sizin tabi.

Sub Serial_Dene()
[a:c] = ""
Dim ds, sr, t
Set ds = CreateObject("Scripting.FileSystemObject")
x = 1
Set sr = ds.Drives
For Each Drv In sr
On Error Resume Next
Select Case ds.GetDrive(Drv).DriveType
Case 0: t = "Bilinmiyor"
Case 1: t = "USB_Disk"
Case 2: t = "HardDisk"
Case 3: t = "Ağ"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
Cells(x, 1).Value = Drv
Cells(x, 2).Value = t
Cells(x, 3).Value = ds.GetDrive(Drv).SerialNumber
x = x + 1
Next
End Sub

Aşağıdaki kodla da istediğiniz sürücünün serinumarasını alabilirsiniz. Sizin işinize yarayacak kod daha çok bu: kırmızı satırda Sürücü türü için numarayı değiştirmelisiniz. Şu an 2 var. Bu HDD için. Üstteki numaralara göre türü belirleyebilirsiniz. C: sürücüsü için ayarlı D: yaparsanız D:'nin serinosunu alırsınız. Drv <> "A:" kısmına dokunmayın. Disket sürücüsü olan bilgisyaralarda sürücüde disket yoksa hata veriyor, bu nedenle bu satırı ekledim. Bir de örnek dosya ekliyorum. Dosyada her iki kod da mevcut.

Sub Lisans()
Dim ds, d
Set ds = CreateObject("Scripting.FileSystemObject")
For Each Drv In ds.Drives
Set d = ds.GetDrive(Drv)
If d.DriveType = 2 And Drv = "C:" And Drv <> "A:" Then
Srl = d.SerialNumber
MsgBox Srl
End If
Next
End Sub

 

[marlalı1]

excel yine açılıyor.

 

[leumruk]

excel yine açılıyor.

Hdd kodu nasıl alınırın cevabıydı?