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

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

Beliebteste Forumthreads (12 Monate)

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

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

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

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread