Hallo Wissende,
nachfolgend sind einige Testmakros in Excel-Vba um herauszufinden und aufzulisten, welche Laufwerke vorhanden sind und welche davon auch benutzbar sind (Disk eingelegt, CD eingelegt)
Was mich daran sehr stört, wenn ich ein Diskettenlaufwerk auf eingelegte Diskette überprüfe, so dauert das locker mindestens 5 Sekunden, man siehts auch am LED des Diskettenlaufwerkes.
Am liebsten wäre mir sowas wie eine API wie GetLogicalDrives, die dann halt GetUseableDrives oder so heißen müßte und schnell ist.
Irgendwie habe ich im Hinterkopf, daß DOS bei Diskettenlaufwerke mehrmals versucht zu lesen, erst wenn das mehrmalige nicht klappt kommt die Meldung „Gerät nicht bereit“ oder so.
Ich suche halt etwas was nur einmal versucht zu lesen, wenn es nicht klappt sofort sagt, „keine Disk eingelegt“, ob das jetzt stimmt oder nur ein Lesefehler vorliegt, der beim nächsten Lesen nicht auftritt, das soll entfallen.
(Die Kommentare im Code haben nix zu bedeuten, sie beziehen sich auf Fehler bei unterschiedlichen Excelversionen aber ich suche ja hier eine VB-Lösung. D.h ich starte eine mit Vb erstellte Exe und sie liefert mir einen String zurück, ACDF, oder schreibt den in eine Textdatei.)
Danke ^ Gruß
Reinhard
Option Explicit
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
'
Sub Test2()
Cells.Clear
Call Lesen2("C:\") ' Festplattenpartition
Call Lesen2("F:\") ' ein USB-Stick, 2 GB, ich glaube FAT-formatiert
End Sub
'
Sub Lesen2(lwk As String)
' beschriebener Fehler 5 kommt bei XL97, XL2000 nicht, aber Code dort dort endlos bei C:\ !?
Dim F As Long
With Application.FileSearch
MsgBox Dir("F:\Artikelbaum4391923.txt") 'klappt problemlos
.NewSearch
.LookIn = lwk
'On Error GoTo Ende 'Fehler bei .FileName bei F:, Stick !??
.FileType = msoFileTypeAllFiles
'Laufzeitfehler 5, Unzulässger Prozeduraufruf oder ungültiges Argument bei F:\
.FileName = "Artikelbaum\*.txt" ' .FileName = "\*.txt" bringt gleichen Fehler
'On Error GoTo 0
.SearchSubFolders = True
' Es wird nix sortiert !??
If .Execute(SortBy:=msoSortByFileName, \_
SortOrder:=msoSortOrderAscending) \> 0 Then
For F = 1 To .FoundFiles.Count
Cells(F + 1, 1) = .FoundFiles(F)
Cells(F + 1, 2) = Mid(.FoundFiles(F), InStr(.FoundFiles(F), "Artikelbaum"))
Next F
End If
End With
Ende:
End Sub
'
Sub test3()
Dim h, N
h = GetLogicalDrives()
' listet alle vorhandenen lw auf, unabhängig ob Disk oder CD eingelegt.
For N = 65 To 90
If h And 2 ^ (N - 65) Then MsgBox Chr(N)
Next N
End Sub
'
Sub test4()
Dim N, Fs As New FileSystemObject
For N = 65 To 90
' kommt Fehler, Gerät nicht verfügbar bei B
If Fs.GetDrive(Chr(N)).IsReady Then MsgBox Chr(N)
Next N
End Sub
'
Sub test5()
'von Ransi
Dim Fs As New FileSystemObject, lwk
' Set-Variante nicht gut weil keine IntelliSense kommt, besser Dim-Variante
'Set Fs = CreateObject("Scripting.filesystemobject")
' langsam, weil Überprüfung von A so lange daurt.
'MsgBox Fs.GetFolder("A:\")
For Each lwk In Fs.drives
If lwk "A:" Then ' deshalb 2 If-Schleifen wegen Schnelleigkeit, d.h. A wird nicht gerprüft
If lwk.IsReady Then MsgBox lwk & "\"
End If
Next lwk
End Sub
'
Sub test6()
If Dir("e:\/nul") "" Then MsgBox "huhu"
End Sub
bastle ich mir das selbst für Excel Vba um:frowning: