检查文件是否处于只读状态(If语句)VBA

时间:2018-08-07 07:29:16

标签: vba excel-vba if-statement readonly

全部,我有下面的代码,我需要检查以下第一个处于只读状态的可用文件,并将该文件名用作更大模块的一部分。

例如,如果另一个用户正在使用Transactions1.csv,则检查是否正在使用Transactions2。

我遇到的问题是,它似乎总是使用Transactions3.csv并忽略文件1,2和4(即使它们未处于只读状态)。任何帮助将非常感激。

Sub CheckIFFileisopen()

'checking multiple files

PMFTransFile = "\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions1.csv"
Set TransworkBook = Workbooks.Open(PMFTransFile)
'Check to see if file is already open

If TransworkBook.ReadOnly Then
    ActiveWorkbook.Close
'check if 2nd file is available
PMFTransFile = "\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions2.csv"
Set TransworkBook = Workbooks.Open(PMFTransFile)
        If TransworkBook.ReadOnly Then
        ActiveWorkbook.Close

'check if 3rd file is available
 PMFTransFile = "\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions3.csv"
 Set TransworkBook = Workbooks.Open(PMFTransFile)

        If TransworkBook.ReadOnly Then
        ActiveWorkbook.Close

 'check if 4th file is available
 PMFTransFile = "\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions4.csv"
 Set TransworkBook = Workbooks.Open(PMFTransFile)

     MsgBox "Cannot update Transactions, someone currently using file.  Please try again in a few minutes."
     Application.ScreenUpdating = True
     Application.Calculation = xlCalculationAutomatic
     End
     Exit Sub

   End If
   End If
   End If
 End Sub

1 个答案:

答案 0 :(得分:1)

由于您具有相同的路径和相似的文件名,因此我们可以使用循环来检查文件的状态。另外,您可能希望查看THIS链接,以了解如何检查文件是否打开。

Sub Sample()
    Dim sPath As String, SFile As String
    Dim i As Long
    Dim Ret As Variant

    sPath = "\\Csdatg04\psproject\Robot\Project Preload\Transactions\Transactions"

    For i = 1 To 4
        SFile = sPath & i & ".csv"

        Ret = IsWorkBookOpen(SFile)

        If Ret = True Then
            MsgBox SFile & " is open. Will now check for next File"
        Else
            MsgBox SFile & " is Closed. We will work with this file"
            Exit For
        End If
    Next i
End Sub

Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function