Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1324to1328
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Verständnisfrage - Laufwerkszugriff

Verständnisfrage - Laufwerkszugriff
27.07.2013 18:08:51
Peter
Hallo zusammen,
ich dachte immer, ich kenne mich in Excel recht gut aus aber gerade sitze ich vor einem Problem, welches ich allein nicht lösen kann: der VBA Code läuft auf dem einen Rechner einwandfrei und auf dem nächsten Rechner (gleiches Windows, gleiches Office) kommt Fehler 71!
Das Programm befindet sich auf einem USB Stick und wird über den Stick von verschiedenen Mitarbeitern genutzt. Damit keine verschiedene Versionen im Umlauf sind, prüft Excel ob der Stick im Laufwerk steckt. Das funktioniert alles und passiert mit folgendem Code:

Private Declare Function GetDriveType Lib "Kernel32" Alias _
"GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare
Function GetLogicalDriveStrings Lib "Kernel32" _
Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6


Sub USBstickCheck()
Dim z As Integer 'Zähler für Balken
Dim r&, alleDrvs$, drv$, pos%, drvtyp&
Dim t As String
alleDrvs$ = VBA.Space$(64)
r& = GetLogicalDriveStrings(Len(alleDrvs$), alleDrvs$)
alleDrvs$ = VBA.Left$(alleDrvs$, r&)
Do
pos% = InStr(alleDrvs$, VBA.Chr$(0))
If pos% Then
drv$ = VBA.Left$(alleDrvs$, pos%)
alleDrvs$ = VBA.Mid$(alleDrvs$, pos% + 1, Len(alleDrvs$))
drvtyp& = GetDriveType(drv$)
'Um welche Art Laufwerk handelt es sich?
Select Case drvtyp&
Case 2
t = "WXL"
Case Else
t = "NFC"
End Select
If t = "WXL" Then
'Erfolgskontrolle, Stick steckt im Laufwerk
Range("B6").Value = "erfolgreich"
End If
End If
Loop Until alleDrvs$ = ""
Exit Sub
End Sub

Wenn in B6 dann das "erfolgreich" eingetragen wurde, ist alles in Ordnung. Merkwürdig ist nur, dass das Programm bei mir läuft, auf den Rechnern meiner Kollegen jedoch nicht. Angezeigt wird "Laufzeitfehler 71 - Datenträger nicht bereit"
Der Datenträger ist aber bereit. Denn vom Datenträger wurde die Datei ja gestartet. Ich habe es mit verschiedenen USB Sticks probiert, an verschiedenen USB Ports, an verschiedenen Rechnern (Win8, Office 2007) aber irgendwie ist da der Wurm drin.
Kennt jemand den Fehler? Oder kann mir jemand sagen, ob der Code bei andern Nutzern läuft? Das würde mir echt weiter helfen. Ich bin echt schon am verzweifeln!
Vielen lieben Dank euch allen!!!!
Peter

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
..bei mir funkts...alles OK ! owT
27.07.2013 18:17:55
robert

AW: ..bei mir funkts...alles OK ! owT
27.07.2013 18:21:31
Peter
Danke für die Rückmeldung. Hast du ne Idee, warum es bei anderen teilweise nicht funktioniert? Ich dachte bisher immer: Code funktioniert oder funktioniert nicht. Aber dass das manchmal geht und manchmal nicht, macht mich echt fertig!

leider nein,aber schon gegoogelt? owT
27.07.2013 18:30:05
robert

AW: leider nein,aber schon gegoogelt? owT
27.07.2013 19:02:18
Peter
Klar. Nur weiß ich nicht so recht, nach was ich googlen soll. Laufzeitfehler 71 ergibt zwar massig Treffer aber die sind inhaltlich zu allgemein.
Und wenn ich nach den Functions suche, dann kommen Treffer zu den Funktionen aber das hilft irgendwie auch nicht. Bin also nach wie vor dankbar für Ideen und Hinweie!

Anzeige
AW: leider nein,aber schon gegoogelt? owT
27.07.2013 20:15:38
Peter
Klar. Nur weiß ich nicht so recht, nach was ich googlen soll. Laufzeitfehler 71 ergibt zwar massig Treffer aber die sind inhaltlich zu allgemein.
Und wenn ich nach den Functions suche, dann kommen Treffer zu den Funktionen aber das hilft irgendwie auch nicht. Bin also nach wie vor dankbar für Ideen und Hinweie!

AW: leider nein,aber schon gegoogelt? owT
28.07.2013 09:06:08
Luschi
Hallo Peter,
teste doch mas diese Routine:

Sub allDrivesList()
Dim GB As Long
Dim HDs, hd
Dim Query
GB = 1073741824
Query = "Select * From Win32_DiskDrive"
Set HDs = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery(Query)
For Each hd In HDs
Debug.Print hd.Model + " " + hd.DeviceID + " " & Round(hd.Size / GB)
Next
End Sub

Für die von mir getesteten USB-Sticks kam dann eine Info dieser Art:
USB DISK 2.0 USB Device \\.\PHYSICALDRIVE4 2
Gruß von Luschi
aus klein-Paris
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige