Excel VBA - 使用基于关键字的Dir查找文件或要求用户对其进行路径查找

时间:2015-07-13 11:17:51

标签: excel vba excel-vba

我是VBA的新手,我正在拉几个宏。它需要根据给定路径(存储在C2)和关键字(存储在D2中)找到一个文件,然后将完整路径打印到E2,如果此文件不是找到,提示一个对话框,以便用户可以找到它(例如,如果出现拼写错误)。

到目前为止我所拥有的:

 Public Sub Pather()

    'Find path to File1 based on KeyWord1
    Dim File1 As Variant, KeyWord1 As String, Path1 As String
    KeyWord1 = Sheet5.Range("d2").Text
    Path1 = Sheet5.Range("c2").Text
   File1 = Dir(MainPath & Path1)
   While (File1 <> "")
      'insert keyword below

      If Sheet5.Range("E2") = "" Then
      'Print File1 path into E2
        Sheet5.Range("E2") = Path1 & File1
      ' Display Error message for test reason
      ' (change to Dialog Script so user can find File1 )
      Else:
         MsgBox "File not found."
         '*** add FileDialog here ***
         Exit Sub
      End If
     File1 = Dir
  Wend

    End Sub

如果我离开Else,则有效...但当我包含Else时,如果文件存在,它会将文件路径返回到E2并显示提醒。我究竟做错了什么?

此外,我希望它显示警报,然后运行以下脚本:

Dim fd As FileDialog
Dim FileName As String
Set fd = Application.FileDialog(msoFileDialogOpen)
'the number of the button chosen
Dim FileChosen As Integer
FileChosen = fd.Show
fd.Title = "Choose workbook"
fd.InitialFileName = "C:\test"
fd.InitialView = msoFileDialogViewList
'show Excel workbooks and macro workbooks
fd.Filters.Clear
fd.Filters.Add "Excel workbooks", "*.xlsx"
fd.Filters.Add "Excel macros", "*.xlsm"
fd.FilterIndex = 1
fd.ButtonName = "Choose this file"
If FileChosen <> -1 Then
'didn't choose anything (clicked on CANCEL)
MsgBox "No file choosen. File wont be saved as .PDF"
Else
'get file, and open it (NAME property
'includes path, which we need)
FileName = fd.SelectedItems(1)
Workbooks.Open (FileName)
End If

是否可以将第二个脚本嵌入到第一个脚本中?

非常感谢

1 个答案:

答案 0 :(得分:0)

您在单元格C2中输入Path1的内容是什么? 如果它是一个文件夹,那么当有任何文件要通过时,While循环会继续。这就是为什么你得到多个输出(即返回两个可能结果)的原因。

KeyWord1的目的是什么?它应该是通配符,扩展名还是文件名?

编辑:

列出与通配符使用匹配的所有文件:

   Public Sub Pather()

    'Find path to File1 based on KeyWord1
    Dim File1 As Variant, KeyWord1 As String, Path1 As String
    KeyWord1 = Sheet5.Range("d2").Text
    Path1 = Sheet5.Range("c2").Text
   File1 = Dir(MainPath & Path1)
   Dim i As Integer
   i = 1
   While (File1 <> "")
      'insert keyword below
    Debug.Print File1
      If Cells(i, 5) = "" Then

        If InStr(File1, KeyWord1) > 0 Then
            'Print File1 path into E2
              Cells(i, 5) = Path1 & File1
            ' Display Error message for test reason
            ' (change to Dialog Script so user can find File1 )
            i = i + 1
            'Exit Sub
        End If
      Else
         Debug.Print "File not found"
         MsgBox "File not found."
         '*** add FileDialog here ***
         Exit Sub
      End If
     File1 = Dir
    Wend

    End Sub

如果您只想首先列出与通配符匹配的内容,请删除&#39;符号来自:&#39;退出Sub(所以它在找到第一个匹配后退出)。