Herbers Excel-Forum - das Archiv

wenn laufwerk nicht vorhanden..., dann laufwerk ..

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: wenn laufwerk nicht vorhanden..., dann laufwerk ..
von: mehmet

Geschrieben am: 12.02.2005 10:52:12
guten tag lieber forum,
ich habe einen makro wo einige strings in eine textdatei eingeschieben werden.
'** Begin Excel Zugriffe ***
Public WithEvents app As Application
Private Sub app_WorkbookOpen(ByVal WBook As Excel.Workbook)
Benutzer = Application.UserName
Datum = Format(Now, "dd.mm.yyyy")
Uhrzeit = Format(Now, "HH:MM")
Dateiname = WBook.FullName
Open "g:\EASC_All\EASC\UserFolder\Mehmet\Excel-Zugriffe.txt" For Append As  #1 'HIER LW
Print #1, Benutzer & vbTab & Datum & vbTab & Uhrzeit & vbTab & Dateiname
Close #1
End Sub

'*** Ende Excel Zugriffe ***
kann man diesen makro so umschreiben, dass wenn laufwerk g: nicht vorhanden ist,
dass dann nach h: oder f: gesucht wird.
herzlichen dank im voraus
gruss
mehmet
Bild

Betrifft: AW: wenn laufwerk nicht vorhanden..., dann laufwer
von: Norman

Geschrieben am: 12.02.2005 11:56:31
Hier eine Routine, die alle Laufwerke auf Deinem Rechner ermittelt. Die sollte sich nach Deinen Bedürfnissen anpassen lassen. Mit dem Typ kannste auch noch herumbasteln.
Beste Grüße
Norman
Private Declare _
Function GetLogicalDrives& Lib "kernel32" ()
Private Declare _
Function GetDriveType Lib _
"kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Const DRIVE_CDROM = 5
Private Const DRIVE_FIXED = 3
Private Const DRIVE_RAMDISK = 6
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_REMOVABLE = 2
Sub LaufwerkeHolen()
Dim a As Long, L As Long
On Error Resume Next
'Bitmaske mit Laufwerken holen
L = GetLogicalDrives
For a = 97 To 123
If L And 2 ^ (a - 97) Then
'Wenn Bit 0 gesetzt, dann LW a vorhanden
'Wenn Bit 1 gesetzt, dann LW b vorhanden
'usw.
Laufwerke.AddItem (UCase(Chr(a)) & ":") ' Laufwerke ist ne ComboBox, kannste ja ändern
End If
Next
End Sub

Bild

Betrifft: AW: wenn laufwerk nicht vorhanden..., dann laufwer
von: mehmet

Geschrieben am: 12.02.2005 12:22:41
hallo norman,
erst mal danke
leider klappt es nicht!
schon wenn ich
Private Declare _
Function GetLogicalDrives& Lib "kernel32" ()
in ein modul einfuege, wird es rot markiert!
ich habe mal herum experimentiert, leider ohne erfolg
gruss
mehmet
Bild

Betrifft: AW: wenn laufwerk nicht vorhanden..., dann laufwer
von: Reinhard

Geschrieben am: 12.02.2005 13:25:01
Hi Mehmet,
kopier mal das rein:
Private Declare Function GetLogicalDrives& Lib "kernel32" ()
Private Declare Function GetDriveType Lib _
"kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Const DRIVE_CDROM = 5
Private Const DRIVE_FIXED = 3
Private Const DRIVE_RAMDISK = 6
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_REMOVABLE = 2
Sub LaufwerkeHolen()
Dim a As Long, L As Long
On Error Resume Next
'Bitmaske mit Laufwerken holen
L = GetLogicalDrives
For a = 97 To 123
If L And 2 ^ (a - 97) Then
'Wenn Bit 0 gesetzt, dann LW a vorhanden
'Wenn Bit 1 gesetzt, dann LW b vorhanden
'usw.
Laufwerke.AddItem (UCase(Chr(a)) & ":") ' Laufwerke ist ne ComboBox, kannste ja ändern
End If
Next
End Sub

Gruß
Reinhard
Bild

Betrifft: AW: wenn laufwerk nicht vorhanden..., dann laufwer
von: mehmet

Geschrieben am: 12.02.2005 13:50:59
hallo reinhard,
leider auch hier kein erfolg
folgende fehlermeldung/button erscheint:
Compile error:
Only comments may appear after End Sub, End Function, or End Property
[OK][Help]
und:
Private Declare Function GetLogicalDrives& Lib "kernel32"
wird markier
dank dir
gruss
mehmet
Bild

Betrifft: AW: wenn laufwerk nicht vorhanden..., dann laufwer
von: Reinhard
Geschrieben am: 12.02.2005 13:59:22
Hi Mehmet,
keine Ahnung was du da falsch machst, irgendwas was nicht zum Code gehört wird erkannt.
Der Code ist okay:
https://www.herber.de/bbs/user/17922.xls
Gruß
Reinhard
Bild

Betrifft: AW: wenn laufwerk nicht vorhanden..., dann laufwer
von: mehmet
Geschrieben am: 12.02.2005 14:18:32
super, hat geklappt
dank dir
aber wie kann ich das jetzt zu meinem makro intigrieren
koenntest du noch mal checken bitte falls es keine umstaende macht
dank und gruss
mehmet
Bild

Betrifft: AW: wenn laufwerk nicht vorhanden..., dann laufwer
von: Reinhard

Geschrieben am: 12.02.2005 14:43:09
Hi Mehmet,
(ungetestet):
in DieseArbeitsmappe:
Public WithEvents app As Application
Private Sub app_WorkbookOpen(ByVal WBook As Excel.Workbook)
Benutzer = Application.UserName
Datum = Format(Now, "dd.mm.yyyy")
Uhrzeit = Format(Now, "HH:MM")
Dateiname = WBook.FullName
Laufw = LaufwerkGFolgendHolen
If Laufw <> "" Then
Open Laufw & ":\EASC_All\EASC\UserFolder\Mehmet\Excel-Zugriffe.txt" For Append As #1  'HIER LW
Print #1, Benutzer & vbTab & Datum & vbTab & Uhrzeit & vbTab & Dateiname
Close #1
Else
MsgBox "gibt kein Laufwerk nach H:"
End If
End Sub
in ein Modul:
Private Declare Function GetLogicalDrives& Lib "kernel32" ()
Private Declare Function GetDriveType Lib _
"kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Const DRIVE_CDROM = 5
Private Const DRIVE_FIXED = 3
Private Const DRIVE_RAMDISK = 6
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_REMOVABLE = 2
Function LaufwerkGFolgendHolen() As String
Dim a As Long, L As Long
On Error Resume Next
'Bitmaske mit Laufwerken holen
LaufwerkGFolgendHolen = ""
L = GetLogicalDrives
For a = 103 To 122 'g bis z
If L And 2 ^ (a - 97) Then
'Wenn Bit 0 gesetzt, dann LW a vorhanden
'Wenn Bit 1 gesetzt, dann LW b vorhanden
'usw.
LaufwerkGFolgendHolen = Chr(a - 32)
Exit For
End If
Next a
End Function

Gruß
Reinhard
Bild

Betrifft: AW: wenn laufwerk nicht vorhanden..., dann laufwer
von: mehmet

Geschrieben am: 13.02.2005 20:29:48
hallo reinhard,
supeer klappt.
nach langem ueberarbeiten habe ich es jetzt -
dank dir
gruss
mehmet
 Bild
Excel-Beispiele zum Thema "wenn laufwerk nicht vorhanden..., dann laufwerk .."
Diskette in Laufwerk A? Laufwerk über InputBox auswählen
Laufwerke im Dialog zur Auswahl anzeigen lassen Erstes CD-ROM-Laufwerk ermitteln
CD-Laufwerk öffnen und schließen Freien Speicherplatz eines abzufragenden Laufwerks ermitteln.
Prüfung, ob ein Laufwerk auf dem Rechner existiert Position an Bandlaufwerk bestimmen