looping VBA crashes if file is open

[snowman1976]

hello

I have the below code that I found on the site and modified it to what I want it to do, and it works great as long as all the files are closed. Basically it loops through all the files in the subfolders I have specified, does some work, closes the file and repeats. However if someone has a file open it crashes and I get an automation error. There are about 30 different files it goes through and they can get renamed without knowing, which is why I chose this method.

Does anyone have any thoughts on what I could do to just skip the file if someone else has it open? I have specified read only already but that doesnt seem to work. Note that I have stripped out the code that applies once in the file just to shorten the post down.....


Public Sub GetReported()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection


Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder("F:\Temp\Weekend")


Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1
For Each oSubfolder In oFolder.SubFolders
queue.Add oSubfolder
Next oSubfolder
For Each oFile In oFolder.Files


On Error GoTo 0
Workbooks.Open Filename:=oFile, UpdateLinks:=False, ReadOnly:=True

Dim NmStr As String
NmStr = ActiveWorkbook.Name


''does its work''

Windows(NmStr).Activate
ActiveWorkbook.Close False


Next oFile
Loop


End Sub

 

[JoeMo]

Is this the line that causes the error?

Workbooks.Open Filename:=oFile, UpdateLinks:=False, ReadOnly:=True

If yes, you can check to see if that workbook is already open (see below) or you can simply ignore it by replacing

On Error GoTo 0 with On Error GoTo Nx

and Next oFile with Nx: Next oFile

To check if a workbook is open:

Function WorkbookOpen(WorkBookName As String) As Boolean
' returns TRUE if the workbook is open
    WorkbookOpen = False
    On Error GoTo WorkBookNotOpen
    If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
        WorkbookOpen = True
        Exit Function
    End If
WorkBookNotOpen:
End Function

Use this function like this:

If Not WorkbookOpen(oFile) Then 
Workbooks.Open Filename:=oFile, UpdateLinks:=False, ReadOnly:=True
Else
Workbooks(oFile).Activate
End If

 

[snowman1976]

thanks Joe, I wasnt able to get your second suggestion to work, but the 'Nx' idea worked. The only issue with it is it fails if the last workbook is open. However I can live with that issue - thanks for the help !