Sürücü İsmi

[pcman]

Arkadaşlar Merhaba,
Bir Sürücünün İsmini Nasıl Okuyabiliriz

Ör. c sürücüsün ismini

 

[Zeki Gürsoy]

Arkadaşlar Merhaba,
Bir Sürücünün İsmini Nasıl Okuyabiliriz

Ör. c sürücüsün ismini

MsgBox CreateObject("Scripting.FileSystemObject"). _
        GetDrive("c:\").VolumeName

 

[ayhan2122]

Sn Zeki Gürsoy;

MsgBox CreateObject("Scripting.FileSystemObject"). _
        GetDrive("c:\").VolumeName

Yazdığınız kodu boş bir butonun tıklatıldığında olay yordamına yazdım ve sadece boş bir ileti görüntülüyor. ? ! ?
Saygılar, iyi çalışmalar.

 

[Zeki Gürsoy]

Yazdığınız kodu boş bir butonun tıklatıldığında olay yordamına yazdım ve sadece boş bir ileti görüntülüyor. ? ! ?
Saygılar, iyi çalışmalar.

Merhaba,

Sürücünün ismi istenmiş. Mesela, bendeki "D:\" sürüsünün ismi "DEPO" dur.
Yani "DEPO (D:\)" şeklinde.

Eğer sürücüye herhangi bir isim verilmediyse boş dönecektir.

 

[pcman]

Zeki Bey öncelikle teşekkür ederim benim bir sorunum var sürücü listesin döndürdüğümde okunamayan sürücülerde hata alıyorum
okunamayan sürücüleri nasıl es gecerim ?

 

[Korhan Ayhan]

Selamlar,

Emin değilim ama hata kontrol satırını eklerseniz es geçebilirsiniz.

1. Alternatif

On Error Resume Next

2. Alternatif

On Error Goto Son

 

[pcman]

Dim TR
Dim surucu
Dim X
Dim y
Dim z
X = DLookup("[prk]", "sayi")
For Each Drives In fs.Drives
surucu = Drives.DriveLetter
surucu1 = surucu & ":\"
If Drives.DriveType = 1 And "YE" = z Then
z = CreateObject("Scripting.FileSystemObject"). _
        GetDrive(surucu1).VolumeName
Me.yolyaz = surucu
TR = Left(Trim(str(Abs(SeriNoAl(surucu & ":\")))) * 1234 + 48778902582457#, 4) & Right(Trim(str(Abs(SeriNoAl(surucu & ":\")))) * 1234 + 48778902582457#, 4) & Left(Trim(str(Abs(SeriNoAl(surucu & ":\")))) * 1234 + 2222222222222#, 4) & Right(Trim(str(Abs(SeriNoAl(surucu & ":\")))) * 1234 + 2222222222222#, 4)

If IsNull(DLookup("[prk]", "sayi")) Or Left(X, 14) <> Left(TR, 6) & Right(TR, 8) Then
stDocName = "proka"
DoCmd.OpenForm stDocName
Else
DoCmd.OpenForm "frmMnGiris"
End If
End If
Next Drives


DoCmd.SetWarnings False
stDocName = "yolyaz"
DoCmd.OpenQuery stDocName, acNormal, acEdit
DoCmd.SetWarnings True

Burda benim yaptığım bir usb diskin numarasını okumak ben Drives.DriveType = 1 And "YE" = z şeklinde sadece çıkartıla bilir ve adı YE olan diske düşmeye çalışıyorum ama olasılıklar içinde pc takılı ama okunamayan hafıza kartı yuvaları var bun larda bir surucu harfi alıyorlar ve hafıza kartı takılı olmadığı zaman okunamıyorlar ozaman "YE" = z bu kısım gümlüyor

 

[Zeki Gürsoy]

Merhaba,

Sorun, sürücünün okunmak için hazır olup olmamasından kaynaklanıyor sanırım.

"GetReady" gibi bir özellikle denetlenebiliyor. Bu ve diğer özellik ve metotların listesini görebilemniz için "FileSystemObject" nesnesinin değişkenini tanımlayarak deneyin.
İlgili ref. dosyası "scrrun.dll"

Değişkeni de şu şekilde tanımlayabilirsiniz.

Dim fso as new Filesystemobject

'.
'.

Kolay gelsin..

 

[pcman]

değişkeni tanımladım ama içinde GetReady dişe bir özellik yok

 

[pcman]

Arkadaşlar Merhaba,

Birsürücünün Okunabilirliğini nasıl anlarız örnek kod la yardımcı olursanız sevinirim

 

[modalı]

Sayın pcman,

Tam olarak ne yapmak istediğinizi anlayamadım. Bir de aşağıdaki kodları deneyin sanırım işinizi görecektir. (Sürücü adı bulma)

 Private Declare Function QueryDosDeviceW Lib "kernel32.dll" ( _
    ByVal lpDeviceName As Long, _
    ByVal lpTargetPath As Long, _
    ByVal ucchMax As Long _
    ) As Long
    Const MAX_PATH = 260


Public Function GetNtDeviceName( _
   ByVal sDrive As String) As String

Dim bDrive() As Byte
Dim bResult() As Byte
Dim lR As Long
Dim sDeviceName As String

   If Right(sDrive, 1) = "\" Then
      If Len(sDrive) > 1 Then
         sDrive = Left(sDrive, Len(sDrive) - 1)
      End If
   End If
   bDrive = sDrive
  
   ReDim Preserve bDrive(0 To UBound(bDrive) + 2) As Byte
   ReDim bResult(0 To MAX_PATH * 2 + 1) As Byte
  
   lR = QueryDosDeviceW(VarPtr(bDrive(0)), VarPtr(bResult(0)), MAX_PATH)
   If (lR > 2) Then
      sDeviceName = bResult
      sDeviceName = Left(sDeviceName, lR - 2)
      GetNtDeviceName = sDeviceName
   End If
  
End Function

Sub Trial()
MsgBox GetNtDeviceName("p:")
End Sub

İyi çalışmalar

 

[pcman]

Sn Modalı Teşekkür Ederim

Kodları denedim sürücünün adını değil de farklı karekterde birşeyler yazıyor

ama okunamayan sürücüde hata vermiyor

tam olarak yapmaya çalıştığım projeye bir çıkartılabir disk yardımıyla lisans anahtarı oluşrurmak yani çıkartılabilir diskin serinosuyla lisans yapmaya çalışıyorum

yaptığım denemelerde Filesystemobject kullandım ama okunamayan disklerde hata üretti okunamayan disklerden kastım pcye takılı hafıza kartı yuvaları hafıza kartı takılı olmadığında sürücü hazır olmuyor

sürücünün okuna bilirliğini denetliyebilirsem sadece çıkartılabilir disklere düşüp ordanda okunabilir disklerden adı x olanın serinosunu alıcam

yardımlarınız için teşekkür ederim

 

[pcman]

Arkadaşlar sürücü harfini bulmaktan vazgeçtim InputBox sürücü harfini kullanıcıdan talep ediyorum bütün döngüleri buna göre revize ettim

teşekkürler...

 

[modalı]

Sayın pcman,

Bir form oluşturun ve bir düğüme ekleyin. Düğümenin klik olayına:

Dim y As Integer

surucu = Array("A:\", "B:\", "C:\", "D:\", "E:\", "F:\", "G:\", "H:\", "I:\", "J:\", "K:\", "L:\", "M:\", "N:\", "O:\", "P:\", "Q:\", "R:\", "S:\", "T:\", "U:\", "V:\", "W:\", "X:\", "Y:\", "Z:\")

For x = 0 To 25

strDrive = CStr(surucu(x))
Call ShowDriveInfo(strDrive)

Next x

kodlarını yapıştırın.

Sonra da bir modül oluşturun ve şu kodları yapıştırın:

Function ShowDriveInfo(drvpath)
    Dim fs, d, s, t
    On Error Resume Next
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(drvpath)
    Select Case d.DriveType
        Case 0: t = "Unknown"
        Case 1: t = "Removable"
        Case 2: t = "Fixed"
        Case 3: t = "Network"
        Case 4: t = "CD-ROM"
        Case 5: t = "RAM Disk"
    End Select
    
    If t = "Removable" Then
        s = "Drive " & drvpath & ": - " & t
        s = s & vbCrLf & "Drive is Ready."
        s = s & vbCrLf & "SN: " & d.SerialNumber
    MsgBox s
    'Else
        's = s & vbCrLf & "Drive is not Ready."
    End If
    
End Function

İyi çalışmalar

 

[pcman]

Sn Modalı verdiğiniz kodlar normal şartlarda çıkartılabilir aygıtın seri nosunu veriyor ama aygıt hazır olmadığında nasıl davranacak daha deneyemedim deneyip buraya yazıcam

teşekkür ederim

 

[kmlpyrz]

USB Bellek sürücü adını hücreye yazdırmak

Kendi bilgisayarımda G:\ sürücüsü olarak görünen USB Belleğimin içine bir Excel Kitabı ekledim. Bu excel kitabının modul kısmına aşağıda verilen kodları yapıştırdım. Makroları çalıştırdığımda Sürücü bilgisi olarak "C:\" sonucunu verdiler.
Bu USB Belek içindeki öğrenci takip programım, yine bu bellekteki "öğrenci resim klasörü" nden öğrenci resimlerini alıyor. Programımdaki öğrenci resimlerini her bilgisayarda görebilmek için USB Belleğimin hangi sürücüde olduğunu excel içinde A1 hücresine yazdırmak istiyorum. Bu konuda yardımcı olabilirseniz çok sevinirim. Çalışmalrınızda başarılar dilerim.