VBA文件选择计数异常：未选文件却显示选中1个的问题求助

Hey there, let's squash that frustrating bug where canceling the file picker incorrectly reports you selected 1 file, and fix the knock-on issue with your ImportTextFiles sub. Here's what's going wrong and how to fix it:

Why This Happens #

When you click Cancel in the GetOpenFilename dialog, it doesn't return an empty array—it returns a Boolean value False. Your current code uses Application.Count(OpenFiles) to count selections, but Excel treats False as the numeric value 0, so Count sees it as one item to count. That's why you get the wrong "1 files" message, and why FileNumber ends up as 1 instead of 0, breaking your ImportTextFiles logic.

The Fix #

We need to first check if the user canceled the dialog, then correctly count the selected files only if they picked something. Here's the revised code:

Updated OpenFile Subroutine #

Public OpenFiles As Variant
Public FileNumber As Integer
Public TextFile As Workbook
Public FileNumberString As String

Public Sub OpenFile()
    OpenFiles = Application.GetOpenFilename(Title:="Select File(s) to Import", MultiSelect:=True)
    
    ' Check if user canceled the dialog
    If VarType(OpenFiles) = vbBoolean And OpenFiles = False Then
        FileNumber = 0
    Else
        ' Count the number of files in the array (GetOpenFilename returns 1-based array)
        FileNumber = UBound(OpenFiles) - LBound(OpenFiles) + 1
    End If
    
    FileNumberString = CStr(FileNumber) ' Use CStr for safe string conversion
    MsgBox "You have selected " & FileNumberString & " file(s)", vbInformation ' Use & instead of + for string concatenation
End Sub

Updated ImportTextFiles Subroutine #

I also cleaned up a couple of small issues here (like redundant ScreenUpdating settings and safer worksheet handling):

Public Sub ImportTextFiles()
    Dim i As Integer
    Dim destWB As Workbook
    
    Set destWB = ThisWorkbook ' Use ThisWorkbook to reliably refer to the workbook with this code
    Application.ScreenUpdating = False
    
    If FileNumber = 0 Then
        MsgBox "You did not select a file. Please select at least one file", vbExclamation
    Else
        For i = LBound(OpenFiles) To UBound(OpenFiles) ' Use array bounds instead of FileNumber for safety
            Set TextFile = Workbooks.Open(OpenFiles(i))
            ' Copy and paste without activating (cleaner and faster)
            TextFile.Sheets(1).Range("A1").CurrentRegion.Copy _
                Destination:=destWB.Worksheets.Add.Range("A1")
            ' Rename the new sheet (trim off file extension for readability)
            destWB.ActiveSheet.Name = Left(TextFile.Name, InStrRev(TextFile.Name, ".") - 1)
            Application.CutCopyMode = False
            TextFile.Close SaveChanges:=False ' Explicitly skip saving changes to text files
        Next i
    End If
    
    Application.ScreenUpdating = True ' Set back to True (you had it set to False twice!)
End Sub

Key Improvements #

• Cancel Detection: Uses VarType to check if OpenFiles is a Boolean (cancel case) instead of relying on unreliable Count logic.
• Safe Counting: Uses array bounds (UBound/LBound) to count selected files, which works reliably for 1-based arrays returned by GetOpenFilename.
• Safer String Handling: Uses & instead of + for concatenation (+ can cause errors if values aren't properly formatted as strings).
• Cleaner Import Flow: Avoids unnecessary worksheet activation, uses ThisWorkbook for clarity, and explicitly sets SaveChanges:=False when closing text files.
• Fixed ScreenUpdating: You had accidentally set it to False twice at the end—now it correctly restores to True.

This should resolve the false "1 selected file" message when canceling, and ensure ImportTextFiles only runs when actual files are selected.

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