Really weird issue with xls being overwritten.

**swoop99** · 09-15-2011, 03:43 PM

My app contains 2 .xls workbooks, the main workbook and the database workbook. Users run the main workbook and do.....stuff, which writes data results to the database workbook.

To guard against errors I have the following code in place in case two users try to submit data to the database workbook at the same time:

Function IsFileLocked(filePath As String) As Boolean
     
    On Error Resume Next
    Open filePath For Binary Access Read Write Lock Read Write As #1
    Close #1
    If Err.Number <> 0 Then
        IsFileLocked = True
        Err.Clear
    Else
        IsFileLocked = False
    End If
    On Error GoTo 0
 
End Function

The above is called from the macro that tries to write data to the database workbook thusly:


Dim path as string
Path = Range("D14").Value

Do Until IsFileLocked(Path) = False
Loop

Workbooks.Open (Path), Password:="temppassword"
Sheets("db").Select
Cells(user, 36).Value = testresult
ActiveWorkbook.Save
ActiveWindow.Close

This works absolutely fine in a test environment, the main workbook will just pause for a few milliseconds when clicking 'Submit' until the database workbook is available. If I open the database workbook manually on another PC then the above code will just sit at an hourglass until I close it on said other PC. No problem.

However, when testing in a larger, slower, environment I've found something very odd.
Very, very rarely (so rarely in fact that it's impossible to replicate), instead of pausing until the database workbook is free instead it gets overwritten by a new, blank workbook with one single test result in cell A1.

And I can't work out why. It might be something to do with a slow network or old, dodgy file server that's causing it to not be able to find the workbook file......

Further testing has discovered that if the database workbook doesn't exist then the main workbook will create a new (blank) one and save it in the original database workbook's location. That I don't get either. Surely, the above code would error in the isfilelocked function and therefore return an = true value and loop?

**tlafferty** · 09-15-2011, 03:47 PM

hmmmm....not sure why either. You could try adding a line to send a ping packet to the file server and if response times are above say 70 ms, then generate the error.

**swoop99** · 09-15-2011, 04:12 PM

Well, what I've done to try and solve this is add the following to the isfilelocked function (original code in italics):



Dim intReturn As Integer
On Error GoTo FileMissing
intReturn = GetAttr(filePath)

 On Error Resume Next
    Open filePath For Binary Access Read Write Lock Read Write As #1
    Close #1
    If Err.Number <> 0 Then
        IsFileLocked = True
        Err.Clear
    Else
        IsFileLocked = False
    End If
    On Error GoTo 0
    
    Exit Function



FileMissing:
    
    IsFileLocked = True

So the first thing the function does is try a GETATTR on the database workbook, if that errors then bypass the rest of the function and return an = true value.....which then causes the calling macro to loop until it does find the file. This tests ok. But I still dont get why it was overwriting the database workbook and I have a feeling it could be important so any help shedding light on the matter would be greatly appreciated.