If file is read only, wait 1 second and try again, on a loop with a count of 5

[Firesword]

Hi

I have a file that can be used by 5 people, it's read only has SQL data in it so it cannot be shared. I'm using Sub Worksheet_Change(ByVal Target As Range) to detect an entry, which will then open a file to save the comments in, add the comment to the last line close and save the file (all of this takes less than 1 second) and is working fine. When writting it I knew it may be an issue if people enter a comment in at the same time, but thought this wouldn't happen very often. I was very wrong. Only the VBA code can access the file that holds the comments, so no one will have this open.

What I'm after is for the sub below to check if the file can be opened as write, but if not wait 1 second and check again on a loop, with a count of 5 so it's not an inifite loop. I cannot get it to do this, any help would be appreciated.

Sub Open_Comments()

    Set Parts = Workbooks.Open(Filename:="***\Expediting Comments - File is locked.xlsm", Password:="***")

End Sub

 

[Tetra201]

See if the following code works for you:

Sub Open_Comments()
    Dim i As Long
    Application.ScreenUpdating = False
    For i = 1 To 5
        Set Parts = Workbooks.Open(Filename:="***\Expediting Comments - File is locked.xlsm", Password:="***")
        If Not ActiveWorkbook.ReadOnly Then Exit For
        ActiveWorkbook.Saved = True
        ActiveWorkbook.Close
        Application.Wait DateAdd("s", 1, Now)
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Firesword]

Done a lot of testing on it and it's working perfectly.

Thank you for all the help it's much appreciated.

 

[Tetra201]

You are welcome.

 

[Siddharth Rout]

@Tetra201 has given a nice solution. Here is another solution which checks if the workbook is open without opening it in Excel.

Option Explicit

Sub Sample()
    Dim Ret
    Dim Tries As Integer
    Dim Parts As Workbook
    Dim flName As String
    
    flName = "***\Expediting Comments - File is locked.xlsm"
    
    Do
        '~~> Check if workbook is open
        Ret = IsWorkBookOpen(flName)
        
        If Ret = False Then
            Set Parts = Workbooks.Open(FileName:=flName, Password:="***")
        Else
            '~~> Wait for 1 second
            Wait 1
            '~~> Update Tries
            Tries = Tries + 1
        End If
        
        '~~> Exit loop is condition is met
        If Ret = False Or Tries > 5 Then Exit Do
    Loop
End Sub

'~~> Check if the workbook is open
Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

'~~> Wait proc
Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub