Question

好的，这是。我在最近3或4个月内完成了一堆编码，学到了很多东西，但是，当我在弹出窗口出现后点击取消时，我无法弄清楚为什么这个代码STILL会打开一个文件过滤的文件名。任何建议都将受到高度赞赏。

 Sub OpenByPartialName()

 '  Returns popup window with only filtered filenames matching
 '  Partial Filename input

 Dim WB As Workbook
 Dim Ans As String
 Dim MyFile As String
 Dim path As String

 '  Folder Path Name for Forms
 path = ("S:\Forms Folder\")

     Ans = InputBox("Enter Partial filename Filter", "Open File With Partial Name Filter")

    MyFile = Dir("S:\Forms Folder\" & "*" & Ans & "*.xls")

     MyFilter = path & "*" & Ans & "*.xls"

     With Application.FileDialog(msoFileDialogOpen)
         .AllowMultiSelect = False
         .InitialFileName = MyFilter

         If .Show = 1 Then
            MyFile = .SelectedItems(1)
         End If
     End With

     On Error Resume Next
     Set WB = Workbooks.Open(MyFile)

 End Sub

Answer 1

那将是一个肮脏的黑客，但如果你在这里有一个Else分支：

If .Show = 1 Then
    MyFile = .SelectedItems(1)
Else
    MyFile = vbNullString
End If

...实际打开文件的代码可以在尝试之前验证MyFile是否为空：

On Error Resume Next
If MyFile <> vbNullString Then Set WB = Workbooks.Open(MyFile)

那就是说我认为你应该在这里处理至少错误53（“找不到文件”），而不是仅仅把所有错误都推到地毯下。

此外，未使用WB引用。也许Sub应该是Function返回打开的工作簿，或Nothing如果打开失败？

Answer 2

这是我用来选择目录的方法。如果函数返回一个空字符串，我不会尝试打开该文件。

Private Function FolderPicker() As String
'*******************************************
' returns directory path to be printed to
'   does not allow multiple selections,
'   so returning the first item in selected
'   items is sufficient.
'
' returns empty string On Error or if the
'   user cancels
'********************************************
On Error GoTo ErrHandler

Const DefaultDirectory As String = "C:Path\to\default\directory\"

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Choose Directory to Print to"
        .InitialFileName = DefaultDirectory
        .InitialView = msoFileDialogViewSmallIcons

        If .Show <> -1 Then
            FolderPicker = vbNullString
        Else
            FolderPicker = .SelectedItems(1)
        End If
    End With

Exit Function

ErrExit:
    FolderPicker = vbNullString
    Exit Function
ErrHandler:
    MsgBox "Unexpected Error: " & Err.number & vbCrLf & "Source: " & Err.Source & _
        "Description: " & Err.Description, vbCritical, "ERROR!"
    Resume ErrExit
End Function

所以，你会这样称呼它。

MyFile = FolderPicker
If MyFile <> vbNullString Then
    Set WB = Workbooks.Open(MyFile)
End If

Answer 3

以后流血，汗水和眼泪（严肃的网上冲浪，拼凑代码并重新测试）我找到了一个答案，在任何时候按“取消”都没有任何问题。

 Sub OpenAuditPartialName()

 '  Returns popup window with only filtered
 '  filenames matching input criteria.
 '  Filenames are saved from another code that uses 3 variables to generate a _
 '  filename 'Filename part1_Filename part2_Filename part3 Forms.xls'

 Dim WB As Workbook
 Dim Ans As String
 Dim MyFile As String
 Dim path As String

 '  Folder path for Forms
 path = ("S:\Forms Folder\")
     Ans = InputBox("Enter any part of the filename to search by." & vbCrLf & vbCrLf & _
     "Full or Partial information is OK." & vbCrLf & vbCrLf & "Filename part1" _
     & vbCrLf & "Filename part2" & vbCrLf & "Filename part3", "Enter Partial Filename Filter")

    '  Exits on 'Cancel' as it should
    If Ans = "" Then
       Exit Sub
    End If

    MyFile = Dir(path & "*" & Ans & "*.xls")
     MyFilter = path & "*" & Ans & "*.xls"

 '*******************************************
     With Application.FileDialog(msoFileDialogOpen)
         .AllowMultiSelect = False
         .InitialFileName = MyFilter

   '  Now accepts the 'Cancel' instead of continuing to open the first file
   '  in the filtered list when pressed
   If .Show = 0 Then
   ElseIf Len(Ans) Then
        MyFile = .SelectedItems(1)
        On Error Resume Next
        Set WB = Workbooks.Open(MyFile)
   Else
       Exit Sub
   End If
 '*******************************************
     End With
 End Sub

即使取消后，Excel VBA仍继续“打开文件”

3 个答案: