AW: Makro automatisch ausführen?
22.06.2021 13:49:17
max.kaffl@gmx.de
Hallo Andreas,
was ist daran jetzt so schwierig:
Code:
[Cc][+][-]
Option Explicit
Option Private Module
Private Declare PtrSafe Function FindFirstChangeNotificationA Lib "kernel32.dll" ( _
ByVal lpPathName As String, _
ByVal bWatchSubtree As Long, _
ByVal dwNotifyFilter As Long) As LongPtr
Private Declare PtrSafe Function FindCloseChangeNotification Lib "kernel32.dll" ( _
ByVal hChangeHandle As LongPtr) As Long
Private Declare PtrSafe Function WaitForMultipleObjects Lib "kernel32.dll" ( _
ByVal nCount As Long, _
ByRef lpHandles As LongPtr, _
ByVal bWaitAll As Long, _
ByVal dwMilliseconds As Long) As Long
Private Const FILE_NOTIFY_CHANGE_FILE_NAME As Long = &H1
Private Const FILE_NOTIFY_CHANGE_DIR_NAME As Long = &H2
Private Const FILE_NOTIFY_CHANGE_ATTRIBUTES As Long = &H4
Private Const FILE_NOTIFY_CHANGE_SIZE As Long = &H8
Private Const FILE_NOTIFY_CHANGE_LAST_WRITE As Long = &H10
Private Const FILE_NOTIFY_CHANGE_SECURITY As Long = &H100
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const INFINITE As Long = &HFFFF
Private Const WAIT_ABANDONED As Long = &H80
Private Const WAIT_FAILED As Long = &HFFFFFFFF
Private Const WAIT_OBJECT_0 As Long = &H0
Private Const WAIT_TIMEOUT As Long = &H102
Private lblnAbort As Boolean
Public Sub Ueberwachung_Start()
' Anpassen - Backslash am Ende nicht löschen
Const FOLDER_PATH As String = "G:\Eigene Dateien\Eigene Excelbeispiele\"
Dim strFileName As String
Dim alngptrNotify(1) As LongPtr
Dim lngWaitStatus As Long
Dim objFileSystem As Object
alngptrNotify(0) = FindFirstChangeNotificationA( _
FOLDER_PATH, True, FILE_NOTIFY_CHANGE_FILE_NAME)
If alngptrNotify(0) = INVALID_HANDLE_VALUE Then
Call MsgBox("Überprüfung auf Dateiänderungen ist nicht möglich")
Exit Sub
End If
alngptrNotify(1) = FindFirstChangeNotificationA( _
FOLDER_PATH, True, FILE_NOTIFY_CHANGE_DIR_NAME)
If alngptrNotify(1) = INVALID_HANDLE_VALUE Then
Call MsgBox("Überprüfung auf Ordneränderungen ist nicht möglich")
Exit Sub
End If
lblnAbort = False
Do
DoEvents
lngWaitStatus = WaitForMultipleObjects(2, alngptrNotify(0), False, 10)
Select Case lngWaitStatus
Case WAIT_OBJECT_0
Set objFileSystem = CreateObject(Class:="Scripting.FileSystemObject")
Worksheets("Tabelle1").Range("A1").Value = _
objFileSystem.GetFolder("C:\Users\Desktop\Excel").Files.Count
Set objFileSystem = Nothing
Call FindCloseChangeNotification(alngptrNotify(0))
alngptrNotify(0) = FindFirstChangeNotificationA( _
FOLDER_PATH, True, FILE_NOTIFY_CHANGE_FILE_NAME)
Case WAIT_OBJECT_0 + 1
MsgBox "Ein Ordner auf " & FOLDER_PATH & " wurde erstellt oder gelöscht."
Call FindCloseChangeNotification(alngptrNotify(1))
alngptrNotify(1) = FindFirstChangeNotificationA( _
FOLDER_PATH, True, FILE_NOTIFY_CHANGE_DIR_NAME)
End Select
Loop Until lblnAbort
Call FindCloseChangeNotification(alngptrNotify(0))
Call FindCloseChangeNotification(alngptrNotify(1))
End Sub
Public Sub Ueberwachung_Stop()
lblnAbort = True
End Sub
Gruß
Nepumuk