Checking For File Existence Loop

[anichols]

Hello All,

I have a code that is supposed to check if a file is open and then call another sub (which sends an email) It is supposed to loop and check every 5 seconds but it doesn't seem to recognize when the file is in place. I'm sure it's just something simple I'm overlooking.

Sub Detect_DAR()
    Const MAX_WAIT_SECS As Long = 7200
    Const WAIT_SECS As Long = 5
    Dim hWnd As Long
    Dim ans As VbMsgBoxResult
    Dim endTime As Single
    endTime = Timer + MAX_WAIT_SECS
    Dim strFileName As String
    Dim strFileExists As String
    strFileName = Sheets(2).Range("D16").Value
    strFileExists = Dir(strFileName)
    Do
           If strFileExists <> "" Then
                Call DAR_Comp
                Exit Sub
            End If
        If Timer > endTime Then
            Call DQ_Fail
            Exit Sub
        Else
            PauseMacro WAIT_SECS
        End If
    Loop
Call DQ_Unknown
End Sub

Any help is much appreciated!

 

[Anthony47]

I normally use the following function to check if a file is free or busy:

Function FileStatus(filename As String) As Variant
'Check file status; codice di ritorno:
'0=file is free, 70=file is busy, 53=file not found
'76=path not found
'altri errori: da indagare
'
    Dim filenum As Integer, errnum As Integer
'
    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
FileStatus = errnum
End Function

Then I use

FStat = FileStatus(FullPathAndNameOfFile)

If FStat=0 then the file is available and free; other values means busy or errors, as described in the comments

Bye

 

[John_w]

I have a code that is supposed to check if a file is open and then call another sub (which sends an email) It is supposed to loop and check every 5 seconds but it doesn't seem to recognize when the file is in place.

Checking whether a file is open or whether it exists are two different things. Which one do you want?

Here is your routine modified to check whether the file exists within the timeout. Note - according to the logic in your code, DQ_Unknown is never called so I've commented it out.

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)
#End If

Sub Detect_DAR()

    Const MAX_WAIT_SECS As Long = 7200
    Const WAIT_SECS As Long = 5
    Dim endTime As Date
    Dim strFileName As String
    Dim strFileExists As String
    
    endTime = DateAdd("s", MAX_WAIT_SECS, Now)
    strFileName = Sheets(2).Range("D16").Value
    
    Do
        strFileExists = Dir(strFileName)
        If strFileExists = vbNullString Then
            Sleep WAIT_SECS * 1000
            DoEvents
        End If
    Loop While strFileExists = vbNullString And Now < endTime
    
    If strFileExists = vbNullString Then
        'Not found
        DQ_Fail
    Else
        'Found
        DAR_Comp
    End If
    
    'DQ_Unknown 'never called in original macro

End Sub

 

[anichols]

Checking whether a file is open or whether it exists are two different things. Which one do you want?

Here is your routine modified to check whether the file exists within the timeout. Note - according to the logic in your code, DQ_Unknown is never called so I've commented it out.

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)
#End If

Sub Detect_DAR()

    Const MAX_WAIT_SECS As Long = 7200
    Const WAIT_SECS As Long = 5
    Dim endTime As Date
    Dim strFileName As String
    Dim strFileExists As String
   
    endTime = DateAdd("s", MAX_WAIT_SECS, Now)
    strFileName = Sheets(2).Range("D16").Value
   
    Do
        strFileExists = Dir(strFileName)
        If strFileExists = vbNullString Then
            Sleep WAIT_SECS * 1000
            DoEvents
        End If
    Loop While strFileExists = vbNullString And Now < endTime
   
    If strFileExists = vbNullString Then
        'Not found
        DQ_Fail
    Else
        'Found
        DAR_Comp
    End If
   
    'DQ_Unknown 'never called in original macro

End Sub

Thank you for the reply. The code seems to immediately call the found response, and I'm not sure why.

 

[anichols]

Your solution works great! When I typed something in, I made an error