Loop until file is available


Active Member
Oct 7, 2002
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
        Open StoreFile For _
             Input Access Read As #1
        While Not EOF(1)
            Line Input #1, ReadText
            ThisInvoice = Val(ReadText)

        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

Some videos you may like

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result


Active Member
Oct 7, 2002
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"
        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
    '// 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

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Latest member

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...