Eğerli sürücü numarası alma...

[leumruk]

Selamlar...
Değerli arkadaşlar, şartlı olarak sürücü seri numarasını almak istiyorum. Şart şu şekilde olacak:
Eğer H:\ sürücüsü varsa seri numarasını al, yoksa G: sürücüsünün seri numarasını al, yoksa F: sürücüsünün seri numarasını al... şeklinde C: sürücüsüne kadar sormasını, bulduğu zaman da A1 hücresine numarayı aktarmasını istiyorum.
Saygılar...

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki linki incelermisiniz.

http://www.excel.web.tr/showthread.php?t=4488

 

[leumruk]

Sub Sürücü_Seri_Numarası_Göster()
On Error GoTo hata:
Dim ds, d, s, t
Set ds = CreateObject("Scripting.FileSystemObject")
Set d = ds.GetDrive("C:\")
Select Case d.DriveType
Case 0: t = "Bilinmiyor"
Case 1: t = "Çıkarılabilir"
Case 2: t = "HardDisk"
Case 3: t = "Ağ"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"

End Select
s = "Sürücü " & d.DriveLetter & ": " & t
If d.IsReady Then
s = s & vbCrLf & d.SerialNumber
MsgBox s

Else
s = s & vbCrLf & "Sürücü Hazır Değil."
MsgBox s
End If
End
hata:
MsgBox "Böyle Bir Sürücü Yok"

End Sub


Syn. Korhan hocam,
Belirttiğiniz linkte işime seri numarası alan şu kodu buldum. Fakat bu kod da sürücü kısmına hangi sürücüyü yazıyorsa onun numarasını veriyor ve msgbox şeklinde veriyor.
Öncelikle benim numarayı hücreye almam lazım.
Sonraki aşama ise bunu şartlı hale getiremedim, getirmem de mümkün değil.
Bundaki amcım ise şu: Ben flash belleğin numarasını almak istiyorum. Fakat bilgisayardan bilgisayara sürücü ismi farklı olabiliyor. Harddiskin bölünme sayısına göre Flashın ismi E, F, G, H... şeklinde değişebiliyor. Ben sondan başlayarak Flashın bulunduğu kısmı yakalamak istiyorum.
Kısaca sizi biraz uğraştıracağım.
Saygılar...

 

[leumruk]

Değerli arkadaşlar,
Yardımlarınızı bekliyorum. Bundaki amacımı da belirtmek istiyorum. Belki farklı bir çözüm bulunabilir. Hazırladığım dosyanın sadece kendi flash belleğimde çalışmasını istiyorum. Flasha verilen ada göre seri numarasını alma gibi bir şey yazılabilirse o da olur.
Saygılar...

 

[leumruk]

Sub Seri()
Dim myfso As Object
Set myfso = CreateObject("Scripting.FileSystemObject")

If myfso.DriveExists("G:\") = True Then
If Range("A1").Value = myfso.GetDrive("G:\").SerialNumber Then
MsgBox "G: Onaylandı"
Exit Sub
End If
End If

If myfso.DriveExists("F:\") = True Then
If Range("A1").Value = myfso.GetDrive("F:\").SerialNumber Then
MsgBox "F: Onaylandı"
Exit Sub
End If
End If

If myfso.DriveExists("E:\") = True Then
If Range("A1").Value = myfso.GetDrive("E:\").SerialNumber Then
MsgBox "E: Onaylandı"
Exit Sub
End If
End If

If myfso.DriveExists("D:\") = True Then
If Range("A1").Value = myfso.GetDrive("D:\").SerialNumber Then
MsgBox "D: Onaylandı"
Exit Sub
End If
End If

If myfso.DriveExists("C:\") = True Then
If Range("A1").Value = myfso.GetDrive("C:\").SerialNumber Then
MsgBox "C: Onaylandı"
Exit Sub
End If
End If

Set myfso = Nothing
End Sub

Şöyle birşey yapmaya çalıştım. Fena olmadı ama Cd-Rom'a denk gelirse "Disk not ready" hata kodu:71 şeklinde hata veriyor.
Yardımcı olursanız sevinirim.

Bir de şöyle ir şey olabilir mi:
Aktif olan sürücünün veya excel kitabının içinde bulunduğu sürücünün seri numarasını alma. Eğer bu olabilirse daha iyi olur.