GetFolder() Fehler ohne SD Karte
17.09.2022 10:27:59
Herbie
Ich prüfe gereade mit folgender Funktion, ob ein Wechseldatenträger angeschlosse ist und bestimme das zugehörige Laufwerk. FUnktioniert auch alles bestens: Aber: Wenn ich nun die SD Karte abziehe, bekomme ich in der Funktion unter Set objFolder = objFSO.GetFolder(strFolder) einen Fehler. Er gibt trotzdem das Laufwerk F:\ als String weiter an die Funktion, obwohl die SD Karte nicht mehr eingesteckt ist. Erst beim Zugriff merkt er das und bringt eine Fehlermeldung.
Offensicjhtlich besteht die Laufwerkszuordnung (F:\) weiterhin. Kann man da noch eine Prüfung einbauen, um diesen Fehler auszuhebeln?
Public Sub LaufwerksCheck(ByVal spfadAkte As String)
Dim objFSO As Object
Dim objDrive As Object
Dim objDriveSystem As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDriveSystem = objFSO.Drives
'Prüfen, ob ein DVD Brenner oder ein Wechseldatenträger angeschlossen ist
For Each objDrive In objDriveSystem
Select Case objDrive.DriveType 'O:Unknown 1:Wechseldatenträger 2:Fixed 3:Netzwerk 4:CD-ROM 5:RAM-Disk
Case 1: '"Removable"
If countFiles2(objDrive & "\", "*.jpg", True) > 0 Then CommandButton11.Enabled = True
Case 4: '"CD-ROM"
End Select
Next
end sub
Public Function countFiles2(ByVal strFolder As String, Optional ByVal FileName As String = "", Optional ByVal SubFolders As Boolean = False) As Long
Dim objFSO As New Scripting.FileSystemObject
Dim objFolder As Object, objFile As Object, objSubF As Object
Dim lngCount As Long
Set objFolder = objFSO.GetFolder(strFolder)
For Each objFile In objFolder.Files
If objFile.Name Like FileName Then lngCount = lngCount + 1
Next
If SubFolders = True Then
For Each objSubF In objFolder.SubFolders
lngCount = lngCount + countFiles2(objSubF.Path, FileName, SubFolders)
Next
End If
countFiles2 = lngCount
Else
countFiles2 = "0"
End If
Set objSubF = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
End Function