Results 1 to 3 of 3
  1. #1
    3 Star Lounger
    Join Date
    Aug 2002
    Location
    milton keynes, Buckinghamshire
    Posts
    252
    Thanks
    0
    Thanked 0 Times in 0 Posts

    File existance testing (2003)

    I am using the following function to test for a file's existance and status before opening
    Function IsFileOpen(filename As String) As String
    Dim filenum As Integer, errnum As Integer
    Dim UserName As String
    On Error Resume Next ' Turn error checking off.
    filenum = FreeFile() ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    UserName = LastUser(filename)
    Close filenum ' Close the file.
    errnum = Err ' Save the error number that occurred.
    On Error GoTo 0 ' Turn error checking back on.
    ' Check to see which error occurred.
    Select Case errnum
    ' No error occurred.
    ' File is NOT already open by another user.
    Case 0
    IsFileOpen = "File is available"
    Case 5
    IsFileOpen = "File does not exist"
    Case 55
    IsFileOpen = "File is available"
    'Error number for "File does not exist"
    Case 53
    IsFileOpen = "File does not exist"
    ' Error number for "Permission Denied."
    ' File is already opened by another user.
    Case 70
    IsFileOpen = "File is open by another user: " & UserName
    ' Another error occurred.
    Case Else
    'Error errnum
    End Select

    End Function

    Private Function LastUser(strPath As String) As String
    '// Code by Helen from http://www.visualbasicforum.com/index.php?s=
    '// This routine gets the Username of the File In Use
    '// Amendment 25th June 2004 by IFM
    '// : Name changes will show old setting
    '// : you need to get the Len of the Name stored just before
    '// : the double Padded Nullstrings
    Dim strXl As String
    Dim strFlag1 As String, strflag2 As String
    Dim i As Integer, j As Integer
    Dim hdlFile As Long
    Dim lNameLen As Byte

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

    hdlFile = FreeFile
    Open strPath For Binary As #hdlFile '******Creates skeleton file close to here*****
    strXl = Space(LOF(hdlFile))
    Get 1, , strXl
    Close #hdlFile

    j = InStr(1, strXl, strflag2)

    #If Not VBA6 Then
    '// Xl97
    For i = j - 1 To 1 Step -1
    If Mid(strXl, i, 1) = Chr(0) Then Exit For
    Next
    i = i + 1
    #Else
    '// Xl2000+
    i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
    #End If

    '// IFM
    lNameLen = Asc(Mid(strXl, i - 3, 1))
    LastUser = Mid(strXl, i, lNameLen)

    End Function

    Program testing has thrown up an error in that if the file does not exist then excel creates a skeleton excel workbook in the directory being searched with the file name that is being sought.

    Further testing indicates that the skeleton file is being created at the point shown

    Can somebody please advise how to stop this from happening?

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: File existance testing (2003)

    The VBA help explicitly states that using Open with Binary as mode will create the file if it doesn't already exist. So you must avoid LastUser if the file doesn't exist. As you can see in the code, the error number that occurs if the file doesn't exist is 53. So change
    <code>
    UserName = LastUser(filename)
    </code>
    to
    <code>If Not Err = 53 Then
    UserName = LastUser(filename)
    End If
    </code>
    This only calls LastUser if the file exists.

  3. #3
    3 Star Lounger
    Join Date
    Aug 2002
    Location
    milton keynes, Buckinghamshire
    Posts
    252
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: File existance testing (2003)

    Thanks Hans. This works now.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •