简体   繁体   中英

Check which file is open VBA

All,

I have a large module which in the earlier part checks whether a files is in use (Readonly) format and if it is in use to open the next file. Ie if file one is in use open file two etc..

In a later part of the module I wish to use the file which has been opened. However I am struggling to identify the file which is opened in the earlier part of the automation and set is as WB.

The code I am currently using is;

  Dim wb As Object
  On Error Resume Next
  Workbooks("\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions1.csv").Activate
  If Err.Number = 0 Then
  wb = GetObject("\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions1.csv")
  GoTo skipline
  End If

On Error GoTo 0
On Error Resume Next
Workbooks("\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions2.csv").Activate
If Err.Number = 0 Then
wb = GetObject("\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions2.csv")
GoTo skipline
End If

 On Error GoTo 0
 On Error Resume Next
 Workbooks("\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions3.csv").Activate
 If Err.Number = 0 Then
 wb = GetObject("\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions3.csv")
 GoTo skipline
 End If

On Error GoTo 0
On Error Resume Next
Workbooks("\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions4.csv").Activate
If Err.Number = 0 Then
wb = GetObject("\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions4.csv")
GoTo skipline
End If

skipline:
On Error GoTo 0

Can anyone recommend how I can identify which file is open and set is as WB

Any help would be much appreciated.

Thanks

Don't try to match the path: mapped drives and aliases will spoof your matches.

Your match term is the file name, with the extension, and you can iterate the Excel workbooks collection to see if there's a matching name:

Option Explicit

Public Function WorkbookIsOpen(WorkBookName As String) As Boolean
' Returns TRUE if a workbook (or csv file open in Excel) is open

Dim wbk As Excel.Workbook

WorkbookIsOpen = False


If IsError(WorkBookName) Then
    WorkbookIsOpen = False
ElseIf WorkBookName = "" Then
    WorkbookIsOpen = False
Else

    For Each wbk In Application.Workbooks
        If wbk.Name = WorkBookName Then
            WorkbookIsOpen = True
            Exit For
        End If
    Next wbk

End If

End Function

Public Function FileName(FilePath As String) As String

' Returns the last element of a network path
' This is usually the file name, but it mat be a folder name if FilePath is a folder path:

' FileName("C:\Temp\Readme.txt")  returns "ReadMe.txt"
' ?FileName("C:\Temp")            returns "Temp"
' FileName("C:\Temp\")            returns ""


' This function does not perform any file checking - the file need not exist, the path
' can be invali or inaccessible. All we're doing is String-handling.

Dim arr() As String
Dim i     As Integer

If IsError(FilePath) Then
    FileName = "#ERROR"
ElseIf FilePath = "" Then
    FileName = ""
Else
    arr = Split(Trim(FilePath), "\")
    i = UBound(arr)
    FileName = arr(i)
    Erase arr
End If

End Function

Then it's just a matter of checking if the open workbook is open read-only:

Dim bReadOnly As Boolean

If WorkbookIsOpen("C:Temp\Brian.csv") Then
    bReadOnly = Application.WorkBooks(FileName("C:Temp\Brian.csv")).ReadOnly
End If

Things get a lot more interesting if you need to check that the file isn't open in another session of Excel, or another application: this code won't test that for you.

I need to answer the other point in your question: opening the file in Excel if it isn't already open in this session.

I would recommend using Application.Workbooks.Open(FileName) for that, as it's smarter than GetObject() and will open the file - csv, xml, xls, xlsx - in Excel, as a workbook, with Excel guessing the necessary format parameters. Also,the native 'open' function allows you to specify additional parameters, like Read-Only.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM