Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop Check for Workbooks already open
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop Check for Workbooks already open
Use the line
OpenMyFileIfNotOpen FoundFile in your loop, with the code below added to your module. HTH, Bernie MS Excel MVP Sub OpenMyFileIfNotOpen(FName As Variant) Dim numSlash As Integer Dim i As Integer 'Get just the filename without the path numSlash = Len(FName) - Len(Application.Substitute(FName, "\", "")) For i = 1 To numSlash FName = Right(FName, Len(FName) - InStr(1, FName, "\")) Next i On Error GoTo OpenFile: Windows(FName).Activate GoTo AlreadyOpen OpenFile: Workbooks.Open FName AlreadyOpen: End Sub "u473" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Check if Any workbooks are open | Excel Programming | |||
Loop Through All Open Workbooks | Excel Programming | |||
Create a Loop to check cells between workbooks | Excel Programming | |||
Loop through all Open workbooks | Excel Programming | |||
Loop through open workbooks | Excel Programming |