determine if workbook is already open

[cmazur71]

I need to determine if a workbook is already open. If it is already open, my code is generating an error.
I am copying a sheet from one workbook to another. If the source workbook is already open, it fails.
If the source workbook is already open, I want to display a message to the user "Workbook sourceworkbook is already open"

Here's what I have...it works great if sourceworkbook is not already open

RQTReport = Application.GetOpenFilename(, , "Browse for IPS / RQT Quotation") 'select a workbook to open
If RQTReport = "False" Then Exit Sub 'exit if user selects Cancel

Set currentworkbook = ThisWorkbook
Set sourceworkbook = Workbooks.Open(RQTReport)
sourceworkbook.Activate

For i = 1 To Worksheets.Count
If Worksheets(i).Name = "Export" Then 'from RQT 'check to see if any of the source workbook sheets are named Export
sourceworkbook.Sheets("Export").Copy before:=currentworkbook.Sheets("QuoteTemplate") 'THIS IS THE LINE THAT ERRORS IF THE WORKBOOK IS ALREADY OPEN
End If
Next i

 

[Norie]

You could try using adding this function that tests, by name, if a workbook is open.

Function IsWBOpen(strWBName As String) As Boolean
Dim wb As Workbook

    For Each wb In Application.Workbooks
        If wb.Name = strWBName Then
            IsWBOpen = True
            Exit Function
        End If
    Next wb

End Function

It could be used in your code like this.

Dim strWBName As String

    RQTReport = Application.GetOpenFilename(, , "Browse for IPS / RQT Quotation")    'select a workbook to open
    If RQTReport = "False" Then Exit Sub    'exit if user selects Cancel
       
    strWBName = Dir(RQTReport)
    
    If IsWBOpen(strWBName) Then
        Set sourceworkbook = Workbooks(strWBName)
    Else
        Set sourceworkbook = Workbooks.Open(RQTReport)
    End If
    
    Set currentworkbook = ThisWorkbook
    
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "Export" Then    'from RQT 'check to see if any of the source workbook sheets are named Export
            sourceworkbook.Sheets("Export").Copy before:=currentworkbook.Sheets("QuoteTemplate")    'THIS IS THE LINE THAT ERRORS IF THE WORKBOOK IS ALREADY OPEN
        End If
    Next i

 

[Saurabhj]

Hi,

Another way:

Dim RQTReport As String
Sub copy()
    RQTReport = Application.GetOpenFilename(, , "Browse for IPS / RQT Quotation") 'select a workbook to open
    If RQTReport = "False" Then Exit Sub 'exit if user selects Cancel
     Set currentworkbook = ThisWorkbook
    'Added below line
     If Not (AlreadyOpen(RQTReport)) Then Exit Sub

    Set sourceworkbook = Workbooks.Open(RQTReport)
    sourceworkbook.Activate
    
    For i = 1 To Worksheets.Count
    If Worksheets(i).Name = "Export" Then 'from RQT 'check to see if any of the source workbook sheets are named Export
    sourceworkbook.Sheets("Export").copy before:=currentworkbook.Sheets("QuoteTemplate") 'THIS IS THE LINE THAT ERRORS IF THE WORKBOOK IS ALREADY OPEN
    End If
    Next i
End Sub

'add below function
Function AlreadyOpen(sFname As String) As Boolean
    Dim wkb As Workbook
    On Error Resume Next
    Set wkb = Workbooks(sFname)
    AlreadyOpen = Not wkb Is Nothing
    Set wkb = Nothing
End Function

 

[cmazur71]

You could try using adding this function that tests, by name, if a workbook is open.

Function IsWBOpen(strWBName As String) As Boolean
Dim wb As Workbook

    For Each wb In Application.Workbooks
        If wb.Name = strWBName Then
            IsWBOpen = True
            Exit Function
        End If
    Next wb

End Function

It could be used in your code like this.

Dim strWBName As String

    RQTReport = Application.GetOpenFilename(, , "Browse for IPS / RQT Quotation")    'select a workbook to open
    If RQTReport = "False" Then Exit Sub    'exit if user selects Cancel
      
    strWBName = Dir(RQTReport)
   
    If IsWBOpen(strWBName) Then
        Set sourceworkbook = Workbooks(strWBName)
    Else
        Set sourceworkbook = Workbooks.Open(RQTReport)
    End If
   
    Set currentworkbook = ThisWorkbook
   
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "Export" Then    'from RQT 'check to see if any of the source workbook sheets are named Export
            sourceworkbook.Sheets("Export").Copy before:=currentworkbook.Sheets("QuoteTemplate")    'THIS IS THE LINE THAT ERRORS IF THE WORKBOOK IS ALREADY OPEN
        End If
    Next i

Worked like a champ...thank you. I was prepared to display a message telling the user to close the open workbook...your solution was so much better. Thank you