Results 1 to 7 of 7

VBA - Checking if a file is already open

This is a discussion on VBA - Checking if a file is already open within the Excel Questions forums, part of the Question Forums category; I have some code which opens the worksbooks in a folder in sequence and carries out some manipulation on them. ...

  1. #1
    New Member
    Join Date
    Oct 2009
    Location
    New Zealand
    Posts
    14

    Default VBA - Checking if a file is already open

    I have some code which opens the worksbooks in a folder in sequence and carries out some manipulation on them. What I can't get working is checking to see if the workbook is open and displaying a suitable message. The code I have for opening the files is as follows:

    Set wbCodeBook = ThisWorkbook
    With Application.FileSearch
    .NewSearch
    .LookIn = nUNCpath
    .FileType = msoFileTypeExcelWorkbooks
    'Optional filter with wildcard
    .Filename = "*.xls"
    If .Execute > 0 Then 'Workbooks in folder
    For lCount = 1 To .FoundFiles.Count 'Loop through all
    'Open Workbook x and Set a Workbook variable to it
    Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

    ' Rest of code here
    Next lCount
    End If
    End With

    I need something at the 'Set wbResults' line to check if the workbook is open by someone else.

  2. #2
    Board Regular
    Join Date
    Apr 2009
    Location
    Northeast PA, USA
    Posts
    11,470

    Default Re: VBA - Checking if a file is already open

    photoman.

    See:
    Is File Open
    See Ivan Moala's page.
    http://www.xcelfiles.com/IsFileOpen.html
    Have a great day,
    hiker95

    Windows 8.1, Excel 2007

  3. #3
    New Member
    Join Date
    Oct 2009
    Location
    New Zealand
    Posts
    14

    Default Re: VBA - Checking if a file is already open

    hiker95 - That gave me something to work on. I tweaked it and part of what I want to do is check if the files are already open, and if so to report which ones are open. This works for one file being open, but when I come across a second open one, I get a run-time error 70: Permission denied. My current bit of code looks like this, and is giving me the error on the 'Open .FoundFiles(lCount) For Random Access Read Write Lock Read Write As hdlFile' line.

    cFileList = ""
    For lCount = 1 To .FoundFiles.Count 'Loop through all
    cCurrentFile = .FoundFiles(lCount)
    On Error GoTo FileIsOpen:
    hdlFile = FreeFile
    Open .FoundFiles(lCount) For Random Access Read Write Lock Read Write As hdlFile
    Close hdlFile
    GoTo EndLoop
    FileIsOpen:
    ' Someone has it open
    cFileList = cFileList + cCurrentFile + ", "
    Close hdlFile
    EndLoop:
    Next lCount
    ' Display message
    MsgBox ("The Following Files Are Currently Open -" & Chr(10) & Chr(10) & cFileList)

  4. #4
    Board Regular
    Join Date
    Apr 2009
    Location
    Northeast PA, USA
    Posts
    11,470

    Default Re: VBA - Checking if a file is already open

    photoman,

    Please post all of your macro code.

    At the beginning of your posted code, enter the following without the quote marks:
    ["code"]


    'Your code goes here.


    At the end of your posted code, enter the following without the quote marks:
    ["/code"]
    Have a great day,
    hiker95

    Windows 8.1, Excel 2007

  5. #5
    New Member
    Join Date
    Oct 2009
    Location
    New Zealand
    Posts
    14

    Default Re: VBA - Checking if a file is already open

    Code:
     
     
    Sub Workplan_Update()
    '
    ' Workplan_Update Macro
    '
     
    Sheet1.Unprotect Password:="******"
    Application.ScreenUpdating = False
    Windows("Workplan.xls").Activate
    ' Get the path of where the files are stored. That way, the files can be moved to any location and won't need updating
    ' Removed last 6 characters to drop off Master folder part
    nUNCpath = Left(ActiveWorkbook.Path, Len(ActiveWorkbook.Path) - 6)
     
    ' Delete existing data from Workbook before updating
    Application.ScreenUpdating = False
    ActiveCell.SpecialCells(xlLastCell).Select
    nLC = ActiveCell.Address
    If ActiveCell.Row <> 1 Then
        Range("A2", nLC).Select
        Selection.Delete
    End If
    ' Select A2 to start process
    Range("A2").Select
    ' repeat for all workbooks in folder
    On Error Resume Next
        Set wbCodeBook = ThisWorkbook
            With Application.FileSearch
                .NewSearch
                .LookIn = nUNCpath
                .FileType = msoFileTypeExcelWorkbooks
                'Optional filter with wildcard
                .Filename = "*.xls"
                    If .Execute > 0 Then 'Workbooks in folder
     
                        ' Check which files are open
                        cFileList = ""
                        For lCount = 1 To .FoundFiles.Count 'Loop through all
                            cCurrentFile = .FoundFiles(lCount)
                            hdlFile = FreeFile
                            On Error GoTo FileIsOpen:
                            Open .FoundFiles(lCount) For Random Access Read Write Lock Read Write As hdlFile
                            Close hdlFile
                            GoTo EndLoop
    FileIsOpen:
                            ' Someone has it open
                            cCF = Left(Right(cCurrentFile, Len(cCurrentFile) - Len(nUNCpath)), Len(Right(cCurrentFile, Len(cCurrentFile) - Len(nUNCpath) - 4)))
                            cFileList = cFileList + cCF + Chr(10)
                            Close hdlFile
    EndLoop:
                        Next lCount
                        ' Display message and exit macro
                        MsgBox ("The Following Files Are Currently Open -" & Chr(10) & Chr(10) & cFileList & Chr(10) & "The Workplan Will Not Update." & Chr(10) & Chr(10) & "Please Close All Open Files And Try Again.")
     
    ' Exit macro at this stage                    
    ' If no files open, process the rest of the macro
     
                        For lCount = 1 To .FoundFiles.Count 'Loop through all
                            'Open Workbook x and Set a Workbook variable to it
     
    ' Wrap the following code with File Open check once working above
    ' *********
                            Worksheets("Summary").Select
                            ActiveCell.SpecialCells(xlLastCell).Select
                            nLC = ActiveCell.Address
                            Range("A2", nLC).Select
                            Selection.Copy
                            Windows("Workplan.xls").Activate
                            ' Don't do for first Workbook
                            If lCount <> 1 Then
                                Range("A1").Select
                                Selection.End(xlDown).Select
                                ActiveCell.Offset(1, 0).Activate
                            End If
                            ActiveSheet.Paste
                            wbResults.Close SaveChanges:=False
    ' *********
                        Next lCount
                    End If
            End With
    On Error GoTo 0
     
    ' add hyperlinks to column B data
    nURLRow = 2
    Range("B1").Select
        ActiveCell.SpecialCells(xlLastCell).Select
    ' Selection.End(xlDown).Select
    nLastRow = ActiveCell.Row
    Do While nURLRow <= nLastRow
        nWBname = Range("A" & nURLRow) & ".xls"
        Range("B" & nURLRow).Select
        nFNtext = ActiveCell.Value
        nFNlink = "#'" & ActiveCell.Value & "'!A1"
        ActiveCell.Formula = "=HYPERLINK(""" & nUNCpath & nWBname & nFNlink & """,""" & nFNtext & """)"
        ' Repeat Contact name in Column G
        ActiveCell.Offset(0, 5).Activate
        ActiveCell.Value = Range("A" & ActiveCell.Row).Value
        nURLRow = nURLRow + 1
    Loop
    ActiveCell.Offset(1, -6).Activate
     
    Application.ScreenUpdating = True
    Sheet1.Protect Password:="******"
    ActiveWorkbook.Save
    Application.ScreenUpdating = False
    End Sub
    The above is all the code I have at the moment. It falls over at the 'Open .FoundFiles(lCount)' line. Once I get the first FileOpen check working, I then plan to wrap the lower code with the same check (just in case).

    An example of the problem is as follows:

    I will have 6 workbooks (A,B,C,D,E,F), one for each individual. This macro is in a separate workbook that collates the data from the other 6. If B and D are open already, I will get the Runtime error 70: Permission denied when I try to open workbook D. The code works fine when dealing with workbooks A,B and C. Hope this makes more sense.

  6. #6
    Board Regular
    Join Date
    Apr 2009
    Location
    Northeast PA, USA
    Posts
    11,470

    Default Re: VBA - Checking if a file is already open

    photoman,

    Sorry for the delay.

    I am not able to work on your request right now.

    Create a new reply, and just use the word "BUMP", and someone else will assist you.
    Have a great day,
    hiker95

    Windows 8.1, Excel 2007

  7. #7
    New Member
    Join Date
    Oct 2009
    Location
    New Zealand
    Posts
    14

    Default Re: VBA - Checking if a file is already open

    That's okay. I cheated slightly to get it working. Instead of it checking all the files and then listing the ones that were opened, it just displays a message saying that at least one file is open.

    It would be nice to find out what the solution is, just in case I get asked to identify which files are open, as opposed to a generic message.

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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


DMCA.com