VBA/Excel/Access/Word/File Path/Drive

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>