简体   繁体   English

检查文件是否打开,包括VBA中的子文件夹

[英]Check if file is open, including subfolders in VBA

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. 如果您想检查文件是否打开,则此代码适用于每个人,这对我有用,因为我不介意3种类型的文件被打开,这不是一种完全可靠的方法。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM