• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Open file if not already open

hsm123

New Member
Hi,

The below code first checks if the required file is open, if it is open then use that file; if not, then open file from the path provided in the cell and read/write with that file. After completing the task, It further checks if the file path & name provided in the below cell is same or not, if same, then do nothing; if not, close the opened file without saving.

It works fine until the file path and name are same in the below cell. Throws an error when the file path and name is different in the below cell. It does not opens the file.

Not sure where am I going wrong. Can someone please help?

Asked here - https://www.mrexcel.com/board/threads/open-file-if-not-already-open.1199858/

Code:
Sub RunQuery1()


Dim Lastrow As Long
Dim OpenBook_path, Available_File As String
Dim FileToOpen As Workbook
Dim wb As Workbook


Application.ScreenUpdating = False


Lastrow = ThisWorkbook.Sheets("Dashboard").Range("F" & Rows.Count).End(xlUp).Row

For i = 9 To Lastrow

    OpenBook_path = ThisWorkbook.Sheets("Dashboard").Cells(i, 6)  'Path includes file name with extension
    OpenBook_Sheet = ThisWorkbook.Sheets("Dashboard").Cells(i, 7)
    OpenBook_Range = ThisWorkbook.Sheets("Dashboard").Cells(i, 8)



'Check if file is open,if open, then use open file; if not, open file from the path in the cell
Available_File = Dir(OpenBook_path) 'extracts the file name from the path

  If Not wbOpen(Available_File, wb) Then Set FileToOpen = Workbooks.Open(OpenBook_path)
  


'open workbook from the path in the cell
With FileToOpen

    'Copy range from the sheet
    With Sheets(OpenBook_Sheet)
       .Range(OpenBook_Range).Select 'Do something
    End With

    
End With


'Check if Below File Path & Name are same
If ThisWorkbook.Sheets("Dashboard").Cells(i, 6) = ThisWorkbook.Sheets("Dashboard").Cells(i + 1, 6) Then

Else
FileToOpen.Close False
End If


Next i


Application.ScreenUpdating = True





End Sub



Function wbOpen(wbName As String, wbO As Workbook) As Boolean
    On Error Resume Next
    Set wbO = Workbooks(wbName)
    wbOpen = Not wbO Is Nothing
End Function
 
hsm123
Have Your checked (solved) - what is FileToOpen-value in the beginning?
If something Throws an error ... then ... how do You solve that Error?
... if error stays alive, then it could do something unwanted ... skip and so on.

There are some challenges to test Your code ... without a sample Excel-file.
 
Back
Top