The code works, but it winds up freezing the program...

I have a module that allows me to delete files from the Temporary Internet Cache. When I execute this command, it deletes all the files, but it never displays the message box and the program just freezes. Also, if I were to have a progress bar called "ProgressBar1" that would show the progress of the deletion, how would I script it?

MODULE:

VB Code:

Option Explicit On 
 
Module Module1
 
    Private Declare Function FindFirstUrlCacheGroup Lib "wininet.dll" ( _
        ByVal dwFlags As Long, _
        ByVal dwFilter As Long, _
        ByRef lpSearchCondition As Long, _
        ByVal dwSearchCondition As Long, _
        ByRef lpGroupId As Date, _
        ByRef lpReserved As Long) As Long
 
    Private Declare Function FindNextUrlCacheGroup Lib "wininet.dll" ( _
        ByVal hFind As Long, _
        ByRef lpGroupId As Date, _
        ByRef lpReserved As Long) As Long
 
    Private Declare Function DeleteUrlCacheGroup Lib "wininet.dll" ( _
        ByVal sGroupID As Date, _
        ByVal dwFlags As Long, _
        ByRef lpReserved As Long) As Long
 
    Private Declare Function FindFirstUrlCacheEntry Lib "wininet.dll" Alias "FindFirstUrlCacheEntryA" ( _
        ByVal lpszUrlSearchPattern As String, _
        ByRef lpFirstCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, _
        ByRef lpdwFirstCacheEntryInfoBufferSize As Long) As Long
 
    Private Structure INTERNET_CACHE_ENTRY_INFO
        Dim dwStructSize As Long
        Dim szRestOfData As Long
    End Structure
 
    Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As Long) As Long
 
    Private Declare Function FindNextUrlCacheEntry Lib "wininet.dll" Alias "FindNextUrlCacheEntryA" ( _
        ByVal hEnumHandle As Long, _
        ByRef lpNextCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, _
        ByRef lpdwNextCacheEntryInfoBufferSize As Long) As Long
 
    Private Const CACHGROUP_SEARCH_ALL = &H0
    Private Const ERROR_NO_MORE_FILES = 18
    Private Const ERROR_NO_MORE_ITEMS = 259
    Private Const CACHEGROUP_FLAG_FLUSHURL_ONDELETE = &H2
    Private Const BUFFERSIZE = 2048
 
    Public Sub Command1_Click()
        Dim sGroupID As Date
        Dim hGroup As Long
        Dim hFile As Long
        Dim sEntryInfo As INTERNET_CACHE_ENTRY_INFO
        Dim iSize As Long
 
        On Error Resume Next
 
        ' Delete the groups
        hGroup = FindFirstUrlCacheGroup(0, 0, 0, 0, sGroupID, 0)
 
        ' To avoid error using it with IE4 as FindFirstUrlCacheGroup is not implemented
        If Err.Number <> 453 Then
            If (hGroup = 0) And (Err.LastDllError <> 2) Then
                MsgBox("An error occurred enumerating the cache groups" & Err.LastDllError)
                Exit Sub
            End If
        Else
            Err.Clear()
        End If
 
        If (hGroup <> 0) Then
            'we succeeded in finding the first cache group.. enumerate and
            'delete
            Do
                If (0 = DeleteUrlCacheGroup(sGroupID, CACHEGROUP_FLAG_FLUSHURL_ONDELETE, 0)) Then
 
                    ' To avoid error using it with IE4 as FindFirstUrlCacheGroup is not implemented
                    If Err.Number <> 453 Then
                        MsgBox("Error deleting cache group " & Err.LastDllError)
                        Exit Sub
                    Else
                        Err.Clear()
                    End If
                End If
                iSize = BUFFERSIZE
                If (0 = FindNextUrlCacheGroup(hGroup, sGroupID, iSize)) And (Err.LastDllError <> 2) Then
                    MsgBox("Error finding next url cache group! - " & Err.LastDllError)
                End If
            Loop Until Err.LastDllError = 2
        End If
 
        ' Delete the files
        sEntryInfo.dwStructSize = 80
        iSize = BUFFERSIZE
        hFile = FindFirstUrlCacheEntry(0, sEntryInfo, iSize)
        If (hFile = 0) Then
            If (Err.LastDllError = ERROR_NO_MORE_ITEMS) Then
                GoTo done
            End If
            MsgBox("ERROR: FindFirstUrlCacheEntry - " & Err.LastDllError)
            Exit Sub
        End If
        Do
            If (0 = DeleteUrlCacheEntry(sEntryInfo.szRestOfData)) _
                And (Err.LastDllError <> 2) Then
                Err.Clear()
            End If
            iSize = BUFFERSIZE
            If (0 = FindNextUrlCacheEntry(hFile, sEntryInfo, iSize)) And (Err.LastDllError <> ERROR_NO_MORE_ITEMS) Then
                MsgBox("Error:  Unable to find the next cache entry - " & Err.LastDllError)
                Exit Sub
            End If
        Loop Until Err.LastDllError = ERROR_NO_MORE_ITEMS
done:
        MsgBox("Items cleared", , "Success!")
    End Sub
 
End Module

and for the command inside the Form:

VB Code:

Module1.Command1_Click()

Place a breakpoint somewhere and step through the code until you get to a method call that never returns, which is one cause for a hung app, or perhaps an infinite loop in your own code.