Excel VBA技术问询：未知扩展名时判断工作簿打开状态及处理

Let's break this down into a practical VBA solution that covers all your requirements—no need to know the file extension upfront, and it clearly distinguishes between locally open files and network-locked ones.

Core Logic Overview #

• First, we'll scan for the target file across the three common Excel extensions (.xls, .xlsx, .xlsm) to find the actual existing file.
• Check if the file is already open in your local Excel instance: if yes, activate it immediately.
• If not locally open, check if it's locked by another user on the network: if yes, show a clear prompt.
• If neither scenario applies, open the file normally.

Full VBA Code #

Sub HandleUnknownExtensionExcelFile()
    Dim targetPath As String
    Dim possibleExtensions As Variant
    Dim actualFilePath As String
    Dim wb As Workbook
    Dim isLocallyOpen As Boolean
    Dim isNetworkLocked As Boolean
    
    ' Set your target file path WITHOUT extension (e.g., "C:\Docs\QuarterlyReport" or "\\Server\Shared\SalesData")
    targetPath = "C:\Your\File\Path\Without\Extension"
    
    ' List of common Excel extensions to check
    possibleExtensions = Array(".xls", ".xlsx", ".xlsm")
    
    ' Step 1: Locate the actual existing file with one of the extensions
    actualFilePath = ""
    Dim ext As Variant
    For Each ext In possibleExtensions
        If Dir(targetPath & ext) <> "" Then
            actualFilePath = targetPath & ext
            Exit For
        End If
    Next ext
    
    ' Exit if no matching file is found
    If actualFilePath = "" Then
        MsgBox "Target file not found with any supported Excel extension.", vbExclamation
        Exit Sub
    End If
    
    ' Step 2: Check if the file is already open locally
    isLocallyOpen = False
    For Each wb In Application.Workbooks
        If StrComp(wb.FullName, actualFilePath, vbTextCompare) = 0 Then
            isLocallyOpen = True
            wb.Activate ' Bring the open workbook to focus
            MsgBox "Workbook is already open locally—activated it for you!", vbInformation
            Exit Sub
        End If
    Next wb
    
    ' Step 3: Check if the file is locked by a network user
    isNetworkLocked = IsFileLocked(actualFilePath)
    
    If isNetworkLocked Then
        MsgBox "This workbook is currently open by another user on the network. Please try again later.", vbExclamation
    Else
        ' Step 4: Open the file since it's not open anywhere
        Workbooks.Open Filename:=actualFilePath
        MsgBox "Workbook opened successfully!", vbInformation
    End If
End Sub

' Helper function to detect if a file is locked by another user
Function IsFileLocked(filePath As String) As Boolean
    Dim fileNum As Integer
    Dim errNum As Integer
    
    On Error Resume Next
    fileNum = FreeFile()
    ' Attempt to open the file with exclusive read-write access
    Open filePath For Input Lock Read Write As #fileNum
    Close #fileNum
    errNum = Err.Number
    On Error GoTo 0
    
    ' Error 70 = Permission Denied (file is locked by another user)
    IsFileLocked = (errNum = 70)
End Function

Key Details Explained #

• Finding the actual file: We loop through the three most common Excel extensions to locate the real file—no need to guess or hardcode the extension beforehand.
• Local open check: We iterate through all currently open workbooks in your Excel instance, using a case-insensitive path comparison to avoid false matches.
• Network lock check: The IsFileLocked function tries to open the file with exclusive access. If it throws error 70, that confirms another user has it open on the network.
• User feedback: Clear, friendly message boxes keep you informed about what's happening in each scenario.

How to Use #

1. Open Excel, press Alt + F11 to launch the VBA Editor.
2. Insert a new module (Right-click your workbook in the Project Explorer > Insert > Module).
3. Paste the code above.
4. Update the targetPath variable to your file's path without the extension.
5. Run the HandleUnknownExtensionExcelFile subroutine.

内容的提问来源于stack exchange，提问作者user3673417