VBA/Excel/Access/Word/File Path/Drive
Содержание
- 1 Display Drive information
- 2 Get Drive Information
- 3 Returns a string that describes the drive type
- 4 Returns the drive letter using an index
- 5 Returns the number of drives
- 6 Returns the number of free bytes for a drive
- 7 Returns the total storage capacity for a drive
- 8 Returns True if a specified drive letter exists
- 9 The NumberOfBytesFree Function
- 10 The TypeOfDrive Function
Display Drive information
<source lang="vb">
Sub cmdDriveInfo_Click()
Dim myFileSystemObject As FileSystemObject, aDrive As Drive Set myFileSystemObject = New FileSystemObject Set aDrive = myFileSystemObject.GetDrive("C:\") With aDrive Debug.Print "Volume Name: " & .VolumeName & vbCrLf Debug.Print "Free Space: " & Format(.FreeSpace / 1000000000#, "#0.00") & "GB" & vbCrLf Debug.Print "Total Size: " & Format(.TotalSize / 1000000000#, "#0.00") & "GB" & vbCrLf Debug.Print "Ready: " & .IsReady End With Set myFileSystemObject = Nothing Set aDrive = Nothing
End Sub Private Sub AddFolders()
</source>
Get Drive Information
<source lang="vb">
Declare Function abGetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Declare Function abGetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long "The GetDriveInfo Procedure Sub GetDriveInfo()
Dim intDrive As Integer Dim strDriveLetter As String Dim strDriveType As String Dim strSpaceFree As String "Loop through all drives For intDrive = 65 To 90 "A through Z strDriveLetter = (Chr(intDrive) & ":\") "Get Drive Type strDriveType = TypeOfDrive(strDriveLetter) "Get Space Free strSpaceFree = NumberOfBytesFree(strDriveLetter) Debug.Print Left(strDriveLetter, 2) & _ " - " & strDriveType & _ IIf(strDriveType <> "Drive Doesn"t Exist", _ strSpaceFree, "") & _ vbCrLf Next intDrive
End Sub
</source>
Returns a string that describes the drive type
<source lang="vb">
Private Declare Function GetDriveType32 Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Function DriveType(DriveLetter As String) As String
DLetter = Left(DriveLetter, 1) & ":" DriveCode = GetDriveType32(DLetter) Select Case DriveCode Case 1: DriveType = "Local" Case 2: DriveType = "Removable" Case 3: DriveType = "Fixed" Case 4: DriveType = "Remote" Case 5: DriveType = "CD-ROM" Case 6: DriveType = "RAM Disk" Case Else: DriveType = "Unknown Drive Type" End Select
End Function Sub Main()
Debug.Print DriveType("c:\")
End Sub
</source>
Returns the drive letter using an index
<source lang="vb">
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Function DriveName(index As Integer) As String
Dim Buffer As String * 255 Dim BuffLen As Long Dim TheDrive As String Dim DriveCount As Integer BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer) TheDrive = "" DriveCount = 0 For i = 1 To BuffLen If Asc(Mid(Buffer, i, 1)) <> 0 Then _ TheDrive = TheDrive & Mid(Buffer, i, 1) If Asc(Mid(Buffer, i, 1)) = 0 Then "null separates drives DriveCount = DriveCount + 1 If DriveCount = index Then DriveName = UCase(Left(TheDrive, 1)) Exit Function End If TheDrive = "" End If Next i
End Function Sub Main()
Debug.Print DriveName(3)
End Sub
</source>
Returns the number of drives
<source lang="vb">
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Function NumberofDrives() As Integer
Dim Buffer As String * 255 Dim BuffLen As Long Dim DriveCount As Integer BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer) DriveCount = 0 For i = 1 To BuffLen If Asc(Mid(Buffer, i, 1)) = 0 Then _ DriveCount = DriveCount + 1 Next i NumberofDrives = DriveCount
End Function Sub Main()
Debug.Print NumberofDrives
End Sub
</source>
Returns the number of free bytes for a drive
<source lang="vb">
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long Sub FreeDiskSpace()
Dim SectorsPerCluster As Long Dim BytesPerSector As Long Dim NumberofFreeClusters As Long Dim TotalClusters As Long x = GetDiskFreeSpace("c:\", SectorsPerCluster, _ BytesPerSector, NumberofFreeClusters, TotalClusters) If x = 0 Then "Error occurred Exit Sub End If Debug.Print SectorsPerCluster Debug.Print BytesPerSector Debug.Print NumberofFreeClusters
End Sub
</source>
Returns the total storage capacity for a drive
<source lang="vb">
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long Sub TotalDiskSpace()
Dim SectorsPerCluster As Long Dim BytesPerSector As Long Dim NumberofFreeClusters As Long Dim TotalClusters As Long x = GetDiskFreeSpace("c:\", SectorsPerCluster, _ BytesPerSector, NumberofFreeClusters, TotalClusters) If x = 0 Then "Error occurred Exit Sub End If Debug.Print SectorsPerCluster Debug.Print BytesPerSector Debug.Print TotalClusters
End Sub
</source>
Returns True if a specified drive letter exists
<source lang="vb">
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Function DriveExists(DriveLetter As String) As Boolean
Dim Buffer As String * 255 Dim BuffLen As Long DLetter = Left(DriveLetter, 1) BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer) DriveExists = False For i = 1 To BuffLen If UCase(Mid(Buffer, i, 1)) = UCase(DLetter) Then DriveExists = True Exit Function End If Next i
End Function Sub Main()
Debug.Print DriveExists("c:\")
End Sub
</source>
The NumberOfBytesFree Function
<source lang="vb">
Function NumberOfBytesFree(ByVal strDrive As String) As String
Dim lngSectors As Long Dim lngBytes As Long Dim lngFreeClusters As Long Dim lngTotalClusters As Long Dim intErrNum As Integer intErrNum = abGetDiskFreeSpace(strDrive, lngSectors, _ lngBytes, lngFreeClusters, lngTotalClusters) NumberOfBytesFree = " with " & _ Format((CDbl(lngBytes) * CDbl(lngSectors)) * _ CDbl(lngFreeClusters), "#,##0") & _ " Bytes Free"
End Function
</source>
The TypeOfDrive Function
<source lang="vb">
Function TypeOfDrive(ByVal strDrive As String) As String
Dim intDriveType As Integer Dim strDriveType As String intDriveType = abGetDriveType(strDrive) Select Case intDriveType Case DRIVE_UNKNOWN strDriveType = "Type Unknown" Case DRIVE_UNAVAILABLE strDriveType = "Drive Doesn"t Exist" Case DRIVE_REMOVABLE strDriveType = "Removable Drive" Case DRIVE_FIXED strDriveType = "Fixed Drive" Case DRIVE_REMOTE strDriveType = "Network Drive" Case DRIVE_CDROM strDriveType = "CD-ROM" Case DRIVE_RAMDISK strDriveType = "RAM Disk" End Select TypeOfDrive = strDriveType
End Function
</source>