Monitoring Folder

'Paste the following into the form:

Option Explicit

Private Sub Command1_Click()
    FileWatch "c:\temp", "test.txt"
End Sub

Private Sub Command2_Click()
    Cancelled = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    ' Make sure we don't have any pending waits...
    Cancelled = True
    Do Until hFolder = 0
        DoEvents
    Loop
End Sub

'And the following into the module:


Option Explicit

' Declaration for async version of ReadDirectoryChangesW
Private Declare Function ReadAsync Lib "kernel32" Alias "ReadDirectoryChangesW" (ByVal hHandle As Long, lpBuffer As Any, ByVal nBufferLen As Long, ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED, ByVal lpCompletionRoutine As Long) As Long

Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long

Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function WaitForSingleObjectEx Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long


Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        Offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type

Public Enum WaitState
    WAIT_FAILED = -1
    WAIT_OBJECT_0 = 0
    WAIT_ABANDONED = &H80
    WAIT_IO_COMPLETION = &HC0
    WAIT_TIMEOUT = &H102
End Enum

Public Enum FileAction
    FILE_ACTION_ADDED = &H1
    FILE_ACTION_REMOVED = &H2
    FILE_ACTION_MODIFIED = &H3
    FILE_ACTION_RENAMED_OLD_NAME = &H4
    FILE_ACTION_RENAMED_NEW_NAME = &H5
End Enum

Public Enum NotificationFilters
    FILE_NOTIFY_CHANGE_FILE_NAME = 1
    FILE_NOTIFY_CHANGE_DIR_NAME = &H2
    FILE_NOTIFY_CHANGE_ATTRIBUTES = &H4
    FILE_NOTIFY_CHANGE_SIZE = &H8
    FILE_NOTIFY_CHANGE_LAST_WRITE = &H10
    FILE_NOTIFY_CHANGE_LAST_ACCESS = &H20
    FILE_NOTIFY_CHANGE_CREATION = &H40
    FILE_NOTIFY_CHANGE_SECURITY = &H100
End Enum

Public Type FILE_NOTIFY_INFORMATION
    NextEntryOffset As Long
    Action As Long
    FileNameLength As Long
    Filename(255) As Byte
End Type

Const FILE_LIST_DIRECTORY = 1
Const GENERIC_WRITE = &H40000000
Const GENERIC_READ = &H80000000
Const FILE_SHARE_DELETE = 4
Const FILE_SHARE_READ = 1
Const OPEN_EXISTING = 3
Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
Const FILE_FLAG_OVERLAPPED = &H40000000

Public cBuffer(1024) As Byte
Public Cancelled As Boolean
Public hEvent As Long
Public OL As OVERLAPPED
Public strFileWatch As String
Public hFolder As Long

Public Sub FileIOCompletionRoutine(ByVal dwErrorCode As Long, ByVal dwNumberofBytes As Long, lpOverlapped As OVERLAPPED)
    Dim wombat As FILE_NOTIFY_INFORMATION ' the infamous wombat!
    Dim strFilename As String
    
    If dwNumberofBytes Then  ' did we get anything?
        CopyMemory wombat, cBuffer(0), dwNumberofBytes
        strFilename = Left(CStr(wombat.Filename), wombat.FileNameLength / 2)
    
        Select Case wombat.Action
            Case FILE_ACTION_ADDED
                If strFilename = strFileWatch Then
                    MsgBox strFilename & " added to monitored folder"
                    Cancelled = True
                End If
            Case FILE_ACTION_MODIFIED
            Case FILE_ACTION_REMOVED
            Case FILE_ACTION_RENAMED_NEW_NAME
            Case FILE_ACTION_RENAMED_OLD_NAME
            Case Else
        End Select
    End If


End Sub

Public Sub FileWatch(ByVal cFolder As String, ByVal strFile As String)
    Dim nFilter As Long
    Dim nReturned As Long
    Dim WaitResult As Long
    Dim mykey As Long
    Dim ByteCount As Long

    strFileWatch = strFile
    Cancelled = False
    ' Create our own event, and stick it in the OVERLAPPED structure so that
    ' we can link it to our asynch ReadDirectoryChagesW
    hEvent = CreateEvent(0&, False, False, "vbReadAsyncEvent")
    OL.hEvent = hEvent
    
    ' Get handle to nominated folder
    hFolder = CreateFile(cFolder, FILE_LIST_DIRECTORY, FILE_SHARE_READ + FILE_SHARE_DELETE, 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS + FILE_FLAG_OVERLAPPED, 0)
    ' Filter the type of file events we want to monitor
    nFilter = FILE_NOTIFY_CHANGE_FILE_NAME + FILE_NOTIFY_CHANGE_LAST_WRITE + FILE_NOTIFY_CHANGE_CREATION
    
    ' Keep looping until user cancels
    Do
        ' set up the async call
        ReadAsync hFolder, cBuffer(0), 1024, False, nFilter, nReturned, OL, AddressOf FileIOCompletionRoutine  ' 0&
        Do
            ' Wait for event or timeout to occur
            WaitResult = WaitForSingleObjectEx(hEvent, 100, True)
            DoEvents ' Yield to OS
        Loop Until (WaitResult = WAIT_IO_COMPLETION) Or (Cancelled = True)
    Loop Until Cancelled

    ' Clean up as we go
    CloseHandle hEvent
    CloseHandle OL.hEvent
    CloseHandle hFolder
    hFolder = 0

End Sub