• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hardisk Serial numarasını Bulmak

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Merhaba arkadaşlar. Sayın leventm'den alınan bir kod ile Computer Name ve User Name çok kolayca bulunabiliyor. Kod Aşağıda :

msgbox environ("computername")

Bunun gibi kısa ve kolay bir yolla Harddisk Serial Numarasını bulmak mümkün mü ?
 
Bu öyle çok kolay bir şey değildir.

Bilgisayardaki işletim sistemi ve diskin tipi önemlidir.

Her makinada çalışacağını garanti edemem ama ekteki dosya, yaptığım bir çok denemede başarılı sonuçlar verdi.
 
Kodlar, MrExcel sitesinden alıntıdır.
http://www.mrexcel.com/board2/viewtopic.php?t=287718&view=next
Kod:
Sub Test()
    MsgBox ShowDriveInfo("C:\")
End Sub

Function ShowDriveInfo(drvpath)
   Dim fso, d
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set d = fso.GetDrive(fso.GetDriveName(fso.GetAbsolutePathName(drvpath)))
   ShowDriveInfo = d.SerialNumber
End Function
 
Sayın hamitcan;

Önerdiğiniz alternatifte sabit diskin fiziksel seri numarası değil, birim seri numarası geriye dönmektedir. Yani, her formatlamadan sonra otomatik olarak değişen, dolayısiyle de fazla güvenilemeyecek bir değerdir.
 
Sayın Hamitcan ve Haluk yardımlarınız için çok teşekkürler. Bu bilgiyi A1 hücresine yazdırmak için kodu nasıl değiştirmek gerekir ?
 
Sayın hamitcan;

Önerdiğiniz alternatifte sabit diskin fiziksel seri numarası değil, birim seri numarası geriye dönmektedir. Yani, her formatlamadan sonra otomatik olarak değişen, dolayısiyle de fazla güvenilemeyecek bir değerdir.
Sayın Haluk; açıkcası konuya sizin kadar vakıf değilim. Verdiğiniz ayrıntı için teşekkürler.
 
Bu öyle çok kolay bir şey değildir.

Bilgisayardaki işletim sistemi ve diskin tipi önemlidir.

Her makinada çalışacağını garanti edemem ama ekteki dosya, yaptığım bir çok denemede başarılı sonuçlar verdi.

hocam teşekkür ederim kodlara göz attım da max ide dirvers = 4 yazan bir satır vardı
satalarda işe yaramıyor mu?
 
Sayın hsayar;

Bahsettiğiniz konu disk sayısı, önemli olan disklerin SMART (Self-Monitoring Analysis and Reporting Technology) desteklemesi.
 
Son düzenleme:
Sayın Hamitcan ve Haluk yardımlarınız için çok teşekkürler. Bu bilgiyi A1 hücresine yazdırmak için kodu nasıl değiştirmek gerekir ?
 
Sayın serdarokan, Sayın Haluk'un verdiği koda bir ekleme yaptım, bilginize...
Kod:
Private Sub DriveSerialNo(MyDrive As String)
    Set ds = CreateObject("Scripting.FileSystemObject")
    Set d = ds.GetDrive(MyDrive)
     Label5.Caption = d.SerialNumber: [a1] = d.SerialNumber
    Label7.Caption = Hex(d.SerialNumber): [a2] = Hex(d.SerialNumber)
End Sub
 
Teşekkürler

Hamitcan ilginize teşekkürler. Şu tarz bir kod satırı nasıl yazılır. Bu konuda yardımcı olur musunuz !!!

If [A1] <> [A2] Then Unload File
 
serdar bey anald&#305;&#287;&#305;m kadar&#305;yla dosya ba&#351;ka bir hardiske kopyalansa bile &#231;al&#305;&#351;mas&#305;n&#305; istemiyorsunuz. e&#287;er do&#287;ru anlm&#305;&#351; isem bu konuda yo&#287;unla&#351;&#305;nca &#231;&#246;z&#252;m bulunabilir., ancak dosyan&#305;z&#305;n yede&#287;inden bu kodu kald&#305;rmassan&#305;z sonra &#231;ok &#252;z&#252;l&#252;rs&#252;n&#252;z.
 
Ne yapmak istedi&#287;inizi daha a&#231;&#305;k yazar m&#305;s&#305;n&#305;z?
 
Peki şöyle sorayım : Dosyayı kaydetmeden kapat kodu nasıl yazılır ? Biraz amatörce olarak aşağıdaki kodu forumdan derledim. Ama Save - No - Cancel sorusunu soruyor.

ElseIf [A1] <> [A2] Then ActiveWorkbook.Close
 
Aşağıdaki şekilde dener misiniz?
Kod:
Sub auto_close()
 ActiveWorkbook.Close False
End Sub
 
Sayın hamitcan çok çok teşekkürler.
 
Geri
Üst