CheckDrive

Attribute VB_Name = "modDrives"
Option Explicit
Public Function CheckDrive(ByVal sDrive As String, _
ByVal sCaption As String) As Boolean
Dim sDir As String
Dim sMsg As String
Dim bIsUNC As Boolean
On Error Resume Next
'SetMousePtr vbHourglass

Do
Err.Number = 0
bIsUNC = False
'

'Attempt to read the current directory of the specified drive. If

'an error occurs, we assume that the drive is not ready

'

If IsUNCName(sDrive) Then
bIsUNC = True
sDir = Dir$(GetUNCShareName(sDrive))
Else
sDir = Dir$(Left$(sDrive, 2))
End If
If Err > 0 Then
If bIsUNC Then
sMsg = Err.Description & vbCrLf & _
"Vom Netzlaufwerk " & sDir & " kann nicht gelesen werden" & _
vbCrLf & "Bitte überprüfe, ob der Pfad korrekt ist und Du die Zugriffsrechte hast."
Else
sMsg = Err.Description & vbCrLf & _
"Vom Laufwerk " & sDir & " kann nicht gelesen werden" & _
vbCrLf & "Bitte überprüfe, ob die Laufwerksklappe geschlossen ist, die Diskette formatiert und fehlerfrei ist ..."
End If
'SetMousePtr

If MsgBox(sMsg, vbExclamation + vbRetryCancel, sCaption) = vbCancel Then
CheckDrive = False
Err.Number = 0
End If
'SetMousePtr vbHourglass

Else
CheckDrive = True
End If
Loop While Err.Number <> 0
'SetMousePtr

End Function

'---====[ pAssed by vbTips32 codeBook ]====---

' #################################################################

' EntPacker für Ace, Rar, Zip

' Copyright Emil Weiss

' für Testzwecke freigestellt

' emil.weiss@koeln.netsurf.de

' http://koeln.netsurf.de/~emil.weiss (Only IE4 or later)

' #################################################################