' GetHDInfo - Get names of all the partitions and drives on a system

Dim FSO, d, Drives, MyStr, n
' Create the FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
' Get the list of drives
Set Drives = FSO.Drives
' Go through the drives and get names
For Each d In Drives
    MyStr = MyStr & d.DriveLetter & " - "
    If d.DriveType = 3 Then
        n = d.ShareName
    Else
        n = d.VolumeName
    End If
    MyStr = MyStr & n & vbCrLf
Next
MsgBox MyStr

If a drive has no title or the title is "" then can't read d.VolumeName and program will crash.

Replace

n = d.VolumeName

with

On Error Resume Next
        n = ""
        n = d.VolumeName