DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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
Kod:MsgBox CreateObject("Scripting.FileSystemObject"). _ GetDrive("c:\").VolumeName
Merhaba,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.
On Error Resume Next
On Error Goto Son
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
Dim fso as new Filesystemobject
'.
'.
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
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
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