Loop until file is available

[Mr_Adams]

I use the attached code (when button is pushed) to input the next number onto a sheet.
Now, with many different user accessing the same text file, I worry they may do so at the same time creating errors.

Would it be possible to look and see if the file is in use before allowing the next user. So basically loop the until the file is avaible or timeout after a mintue.

Or am I just over thinking this and should I leave the code alone.

Dim ThisInvoice As Long
Dim ReadText As String
Dim StoreFile As String

    'read previous number:
    If Dir(StoreFile) = "" Then    'not found
        ThisInvoice = 1
    Else
        Open StoreFile For _
             Input Access Read As #1
        While Not EOF(1)
            Line Input #1, ReadText
            ThisInvoice = Val(ReadText)
        Wend

        Close #1
    End If

    ThisInvoice = ThisInvoice + 1
    'Store this number:

    Open StoreFile For _
         Output Access Write As #1
    Print #1, ThisInvoice
    Close #1
    With ActiveSheet.Range("C5")   'change to suit
        .Value = ThisInvoice
    End With

 

[Mr_Adams]

This code appears to work with excel files but it does not appear to work with a text (.txt) file. It says it can be used with ANY FILE, but does any include txt files?

Any Ideas?

Option Explicit

Sub TestVBA()
'// Just change the file to test here
Const strFileToOpen As String = "\\Star\EPC\Fin_AR\Admin\TestFile.txt"

    If IsFileOpen(strFileToOpen) Then
        MsgBox strFileToOpen & " is already Open" & _
            vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
    Else
        MsgBox strFileToOpen & " is not open"
    End If
End Sub

Function IsFileOpen(strFullPathFileName As String) As Boolean
'// VBA version to check if File is Open
'// We can use this for ANY FILE not just Excel!
'// Ivan F Moala
'// http://www.xcelfiles.com

Dim hdlFile As Long

    '// Error is generated if you try
    '// opening a File for ReadWrite lock >> MUST BE OPEN!
    On Error GoTo FileIsOpen:
    hdlFile = FreeFile
    Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile
    IsFileOpen = False
    Close hdlFile
    Exit Function
FileIsOpen:
    '// Someone has it open!
    IsFileOpen = True
    Close hdlFile
End Function

Function LastUser(strPath As String) As String
'// Code by Helen
'// This routine gets the Username of the File In Use
'// Credit goes to Helen
Dim text As String
Dim strFlag1 As String, strflag2 As String
Dim i As Integer, j As Integer

strFlag1 = Chr(0) & Chr(0)
strflag2 = Chr(32) & Chr(32)

Open strPath For Binary As #1
    text = Space(LOF(1))
    Get 1, , text
Close #1
j = InStr(1, text, strflag2)
i = InStrRev(text, strFlag1, j) + Len(strFlag1)
LastUser = Mid(text, i, j - i)

End Function