Loop until file is available

Mr_Adams

Active Member
Joined
Oct 7, 2002
Messages
475
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.

Code:
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
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

Mr_Adams

Active Member
Joined
Oct 7, 2002
Messages
475
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?

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,133,325
Messages
5,658,166
Members
418,430
Latest member
Chlwls808

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top