mokhtar
04-23-2015, 07:27 AM
hi all
this code is working in win7_32 but is not working in win7_64
Please modify below code to be working in win7_64
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
Function DriveSize(DriveLetter As String) As String
Dim Status As Long
Dim TotalBytes As Currency
Dim FreeBytes As Currency
Dim BytesAvailableToCaller As Currency
Status = GetDiskFreeSpaceEx(DriveLetter & ":\", _
BytesAvailableToCaller, TotalBytes, FreeBytes)
If Status <> 0 Then
DriveSize = TotalBytes * 10000
Else
DriveSize = ""
End If
End Function
Function DriveSpaceFree(DriveLetter As String) As String
Dim Status As Long
Dim TotalBytes As Currency
Dim FreeBytes As Currency
Dim BytesAvailableToCaller As Currency
Status = GetDiskFreeSpaceEx(DriveLetter & ":\", _
BytesAvailableToCaller, TotalBytes, FreeBytes)
If Status <> 0 Then
DriveSpaceFree = FreeBytes * 10000
Else
DriveSpaceFree = ""
End If
End Function
Function DriveType(DriveLetter As String) As String
' Returns a string that describes the type of drive of DriveLetter
DriveLetter = Left(DriveLetter, 1) & ":\"
Select Case GetDriveType(DriveLetter)
Case 0: DriveType = "Unknown"
Case 1: DriveType = "Non-existent"
Case 2: DriveType = "Removable drive"
Case 3: DriveType = "Fixed drive"
Case 4: DriveType = "Network drive"
Case 5: DriveType = "CD-ROM drive"
Case 6: DriveType = "RAM disk"
Case Else: DriveType = "Unknown drive type"
End Select
End Function
Sub ShowAllDrives()
Dim LetterCode As Long
Dim Row As Long
Dim DT As String
Range("A1:D1") = Array("Drive", "Type", "Total Bytes", "Free Bytes")
Row = 2
For LetterCode = 65 To 90
DT = DriveType(Chr(LetterCode))
If DT <> "Non-existent" Then
Cells(Row, 1) = Chr(LetterCode) & ":\"
Cells(Row, 2) = DT
Cells(Row, 3) = DriveSize(Chr(LetterCode))
Cells(Row, 4) = DriveSpaceFree(Chr(LetterCode))
Row = Row + 1
End If
Next LetterCode
End Sub
Thanks in advance for all your help!!
mokhtar
this code is working in win7_32 but is not working in win7_64
Please modify below code to be working in win7_64
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
Function DriveSize(DriveLetter As String) As String
Dim Status As Long
Dim TotalBytes As Currency
Dim FreeBytes As Currency
Dim BytesAvailableToCaller As Currency
Status = GetDiskFreeSpaceEx(DriveLetter & ":\", _
BytesAvailableToCaller, TotalBytes, FreeBytes)
If Status <> 0 Then
DriveSize = TotalBytes * 10000
Else
DriveSize = ""
End If
End Function
Function DriveSpaceFree(DriveLetter As String) As String
Dim Status As Long
Dim TotalBytes As Currency
Dim FreeBytes As Currency
Dim BytesAvailableToCaller As Currency
Status = GetDiskFreeSpaceEx(DriveLetter & ":\", _
BytesAvailableToCaller, TotalBytes, FreeBytes)
If Status <> 0 Then
DriveSpaceFree = FreeBytes * 10000
Else
DriveSpaceFree = ""
End If
End Function
Function DriveType(DriveLetter As String) As String
' Returns a string that describes the type of drive of DriveLetter
DriveLetter = Left(DriveLetter, 1) & ":\"
Select Case GetDriveType(DriveLetter)
Case 0: DriveType = "Unknown"
Case 1: DriveType = "Non-existent"
Case 2: DriveType = "Removable drive"
Case 3: DriveType = "Fixed drive"
Case 4: DriveType = "Network drive"
Case 5: DriveType = "CD-ROM drive"
Case 6: DriveType = "RAM disk"
Case Else: DriveType = "Unknown drive type"
End Select
End Function
Sub ShowAllDrives()
Dim LetterCode As Long
Dim Row As Long
Dim DT As String
Range("A1:D1") = Array("Drive", "Type", "Total Bytes", "Free Bytes")
Row = 2
For LetterCode = 65 To 90
DT = DriveType(Chr(LetterCode))
If DT <> "Non-existent" Then
Cells(Row, 1) = Chr(LetterCode) & ":\"
Cells(Row, 2) = DT
Cells(Row, 3) = DriveSize(Chr(LetterCode))
Cells(Row, 4) = DriveSpaceFree(Chr(LetterCode))
Row = Row + 1
End If
Next LetterCode
End Sub
Thanks in advance for all your help!!
mokhtar