I need to check if a file is already open in order to speed up my code. Currently, it loops through a list, opens a file with a path and the file name comes from the list, there's a few lines of code that means if the file I want to open is in a folder within this path, it can still do that:
If Not IsFileOpen("G:\BS\Josh Whitfield\1. Work work\Credit_Chasing\NEW PROCESS\" & file) Then
If filevar <> "" Then
Workbooks.Open "G:\BS\Josh Whitfield\1. Work work\Credit_Chasing\NEW PROCESS\" & file
Else
Workbooks.Open "G:\BS\Josh Whitfield\1. Work work\Credit_Chasing\NEW PROCESS\" & Range("F" & i).Value & "\" & file
End If
End If
I also have a function that will detect if the file is already open, but I would like a better one or some help getting this current one to work with subfolders:
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
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
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 = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function
Thanks for any help!
Managed to solve it with a different function:
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
subCheck = False
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
IsWorkBookOpen = ""
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: IsWorkBookOpen = ""
End Select
End Function
and the setup for the sub:
ret = IsWorkBookOpen("G:\BS\Josh Whitfield\1. Work work\Credit_Chasing\NEW PROCESS\" & file)
retSub = subCheck
If ret <> True Then
If ret = False Then
Workbooks.Open "G:\BS\Josh Whitfield\1. Work work\Credit_Chasing\NEW PROCESS\" & file
ElseIf ret = "" Then
'subCheck = True
Workbooks.Open "G:\BS\Josh Whitfield\1. Work work\Credit_Chasing\NEW PROCESS\" & Range("F" & i).Value & "\" & file
End If
End If
THIS CODE WONT WORK FOR EVERYONE IF YOU WANT TO CHECK IF THE FILE IS OPEN, it works for my purposes because I don't mind 3 types of files being open, this is not an entirely reliable method.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.