Hi guys, hope you can help me as I have an urgent problem.

A simple "stats submitter" workbook that I designed to be used by 1 small team is now being used by 200+ people in my office due to the current staffing situation.

Our computers and network are so slow that people are essentially bumping heads while trying to send their stats to an external workbook.

The data they are inputting is a only a few Kb in size, so it should just be a case of checking if the workbook is available, opening it, doing a 2nd check to make sure the file is not Read Only due to another user being in at the same time, then adding the new data and saving and closing the file. Pretty straightforward, or so you'd think... here's the code I've been using, which is a bit ugly, but has worked successfully up until now (it makes 10 attempts to access the data bank file then gives up):

Function FileAlreadyOpen(FullFileName As String) As Boolean

    Dim f As Integer: f = FreeFile

    On Error Resume Next
        Open FullFileName For Binary Access Read Write Lock Read Write As #f
        Close #f
        If Err.Number <> 0 Then
            FileAlreadyOpen = True
            Err.Clear
        Else
            FileAlreadyOpen = False
        End If
    On Error GoTo 0

End Function
Sub OpenBank(BankNumber)

    Dim i as Long
666
    i = i + 1

' Check that the Data Bank is not in use or Read Only...

    On Error GoTo 888
        If FileAlreadyOpen(ThisWorkbook.Path & "\Data Banks\" & BankNumber & ".xlsb") = True Then GoTo 888
        Workbooks.Open Filename:=ThisWorkbook.Path & "\Data Banks\" & BankNumber & ".xlsb", Password:="WHATEVER" '''  PASSWORD IS SUPPLIED HERE
        If ActiveWorkbook.ReadOnly = True Or ActiveWorkbook.Name <> BankNumber & ".xlsb" Or ActiveSheet.Name <> "Bank" Then GoTo 888
    On Error GoTo 0
    Exit Sub '''  EXITING SUB HERE LEADS TO THE CODE WHERE THE FILE IS ACTUALLY WRITTEN TO, WHICH WORKS FINE

888
    Err.Clear
    On Error GoTo 0
    For Each wb In Workbooks
        If wb.Name = BankNumber & ".xlsb" Then wb.Close False
    Next wb

' If the Data Bank is busy, try again after a 1 second pause, but give up after 10 attempts...

    If i < 10 Then
        Application.Wait (Now + TimeValue("0:00:01"))
        GoTo 666
    End If

    MsgBox "The data bank is currently in use.  Please try again in a few seconds.", vbCritical, "Error"
    End

End Sub
This worked fine when there were less staff using the system, but now that there are 200+ the users are frequently getting prompted for a password when the Data Bank workbook is being opened, despite the password already being supplied in the vba code! I'd rather it just failed entirely at this point rather than prompt for a password, as this is confusing the users (who are not at all computer savvy, which is why we need a silly system like this in the first place).

I am open to hearing any suggestions anyone has, no matter how bizarre! I don't want to have to resort to giving every user their own "data bank" and then cobbling all that data together, but I fear that might end up being the only viable option (I have already split the "data bank" into 10 chunks to try and ease the pressure, essentially dividing the staff evenly over all 10 banks, but even this has only helped slightly).

Here are a few notes:
  • I can't give the users the password as all the other users' data within the workbook is sensitive (it all gets updated with ScreenUpdating off etc.)
  • We have tried using shared workbooks in the past but these always end up corrupting.
  • We don't have Office 365 or SharePoint so I can't try "co-authoring" or anything like that, which I'm not at all familiar with anyway.
  • I know that having so many people write to the same workbooks is not at all ideal, but I can't use Access to store any of the data as it is not available on our systems.

Thanks a lot for reading all this anyway, any help would be much appreciated.