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

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
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

Beiträge aus den Excel-Beispielen zum Thema "wenn laufwerk nicht vorhanden..., dann laufwerk .."