AW: Laufwerke auf dem System
30.07.2006 17:02:31
Tino
Hallo,
so einfach??? Danke.
Habe auch etwas gefunden und daran etwas gebaut.
Aber das es auch so einfach geht hätte ich nicht gedacht.
Hier meine Version:
Option Explicit
Dim Laufwerke As Boolean
Declare
Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal nDrive As String) As Long
Declare
Function GetLogicalDriveStrings Lib _
"kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Public Const DRIVE_CDROM As Long = 5
Function CdRomLWBuchstabe(strPath As String) As Boolean
Dim sLW As String
Dim l As Long
Dim l1 As Long
Dim sBuffer As String
sBuffer = Space(200)
l = GetLogicalDriveStrings(200, sBuffer)
l1 = 1
sLW = Mid(sBuffer, l1, 3)
Do While (Mid(sBuffer, l1, 1) <> vbNullChar)
If UCase(strPath) = sLW Then
CdRomLWBuchstabe = True
Exit Function
End If
l1 = l1 + 4
sLW = Mid(sBuffer, l1, 3)
Loop
End Function
Sub Laufwerkprüfung()
If CdRomLWBuchstabe("I:\") = True Or _
CdRomLWBuchstabe("J:\") = True Or _
CdRomLWBuchstabe("K:\") = True Or _
CdRomLWBuchstabe("L:\") = True Or _
CdRomLWBuchstabe("M:\") = True Or _
CdRomLWBuchstabe("N:\") = True Or _
CdRomLWBuchstabe("O:\") = True Or _
CdRomLWBuchstabe("P:\") = True Then
Laufwerke = True 'Laufwerke falsch Makro geht nicht
MsgBox "Laufwerke auf diesem System gehen zu diesem Makro nicht!" & Chr(10) & _
"Wenden sie sich an >Tino<" & Chr(10) & Chr(10) & _
"Diese Informationen werden gebraucht:" & Chr(10) & _
"Welche Laufwerksbuchstaben werden von Ihrem System verwendet?" & Chr(10) & _
"Alle vergebenen Buchstaben auch von Wechseldatenträger", vbCritical, "!!!!Makro geht nicht!!!!"
Else
Laufwerke = False 'Laufwerke richtig Makro geht
End If
End Sub
Sub startprüf()
Call Laufwerkprüfung
If Laufwerke = True Then End
End Sub