This loop thru all worksheets in the Folder works fine.
But the trapping of workbooks already open and their user names does
not, or it returns all workbooks names, like in my first test.
I do not want to have any intermediate halts and promptings.
I want after the last loop, a message displaying any workbook names
already open and their user.names.
Help appreciated,
J.P.
..
Sub CheckOpenWB()
On Error Resume Next
Dim SheetName As String, MyValue As String, defAnswer As String,
Source As String
Dim Dest As String, DestPath As String, Message As String, Title
As String
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
defAnswer = "08 - October"
Message = "Enter Source Workbook"
Title = "Source Workbook"
MyValue = InputBox(Message, Title, defAnswer)
DestPath = "P:\Cost Reports\"
If MyValue < Empty Then
Source = DestPath + MyValue
End If
Application.ScreenUpdating = False
Dim FoundFile As String
Message = ""
FoundFile = Dir(Source + "\*.xls")
Do While FoundFile < ""
Workbooks.Open Source + "\" + FoundFile, ReadOnly:=True
' Checking if workbook is already open
' This first test finds them all open, which is wrong
'If Err = 0 Then
'This second test gives an Invalid qualifier Error
If FoundFile.IsOpen Then
Message = Message & FoundFile & Application.UserName &
vbLf
End If
ActiveWorkbook.Saved = True
ActiveWorkbook.Close True
FoundFile = Dir()
Loop
Application.ScreenUpdating = True
MsgBox Message
End Sub