How to format drive using VBA. Use it with extreme caution.

Please use this code with extreme caution

Private Declare PtrSafe Function SHFormatDrive Lib "shell32" (ByVal hWnd As Long, ByVal Drive As Long, ByVal fmtID As Long, _
   ByVal Options As Long) As Long()
Private Declare PtrSafe Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Const FORMAT_FULL = &H1

Public Function FormatDrive(ByVal DriveLetter As String, _
Optional PermitNonRemovableFormat As Boolean = False) As _
Boolean

''**************************************************
'Formats a drive specified by Drive Letter.
'Confirmation box will appear

'Set PermitNonRemovableFormat to true if you want to allow for _
formating of fixed drive or other non-removable drive (e.g., C:)

'Returns true if successful, false otherwise

'EXAMPLE 1: FormatDrive "A: """
'formats drive A:

'EXAMPLE 2: FormatDrive "C: """
'Will fail because PermitNonRemovableFormat is not set
'to True

'I have not tested formatting fixed drives because there
'are no fixed drives I want to format

'USE WITH CAUTION: IF YOU DON’T FOLLOW INSTRUCTIONS
'YOU CAN WIPE OUT SOMEONE’S HARD DRIVE

'**************************************************
Dim sDrive As String
Dim lDrive As Long
Dim iDriveType As Integer
Dim iAns As Integer
Dim sDriveLetter
Dim lRet As Long

sDrive = UCase(DriveLetter)
sDriveLetter = sDrive
'format as [Letter]:/ if not done already
If Len(sDrive) = 1 Then sDriveLetter = sDriveLetter & ": """
If Len(sDrive) = 2 And Right$(sDrive, 1) = ":""" _
Then sDriveLetter = sDrive & """"

lDrive = Asc(Left(sDrive, 1)) - 65

iDriveType = DriveType(sDrive)
Select Case iDriveType

Case 2

lRet = SHFormatDrive(Me.hWnd, lDrive, HFFFF, FORMAT_FULL)
FormatDrive = lRet = 0
Case 3, 4, 5, 6
If Not PermitNonRemovableFormat Then Exit Function
lRet = SHFormatDrive(Me.hWnd, lDrive, HFFFF, FORMAT_FULL)
FormatDrive = lRet = 0
Case Else 'no such drive
Exit Function
End Select

End Function

Private Function DriveType(Drive As String) As Integer

Dim sAns As String, lAns As Long

'fix bad parameter values
If Len(Drive) = 1 Then Drive = Drive & ": """
If Len(Drive) = 2 And Right$(Drive, 1) = ":""" _
Then Drive = Drive & """"

DriveType = GetDriveType(Drive)

End Function