时间戳

首页 > 解决方案 > VBA/Excel：在 Windows 资源管理器中搜索和过滤变量文件夹，选择一个文件夹，然后导入其文件

excel - VBA/Excel：在 Windows 资源管理器中搜索和过滤变量文件夹，选择一个文件夹，然后导入其文件

问题描述

目标是能够根据 Excel 中选定的单元格及其下方的“分类”单元格执行目录搜索，并返回目录中名称包含此选定信息的所有文件夹。从那里，我希望能够从该列表中选择一个文件夹，并将其文本文件导入到最初选择的单元格旁边的 Excel 工作表中。

理想情况下，我希望它在一个循环中工作，它会重复这个过程四次，并将数据从四个不同的文件夹导入到新列中。所有这些都是为了自动化一些数据比较。

据我了解，没有办法在 VBA 的Application.FileDialog(msoFileDialogFolderPicker) 功能中过滤文件夹结果，所以我一直在试图找出一种解决方法。使用此处其他帖子中的一些代码，我已经能够让 VBA 重新创建搜索功能并将其拉到资源管理器窗口中，但是，我不明白如何在文件导入功能中使用此搜索字符串。这是我当前的代码，它可以让我进入我需要的过滤文件夹窗口：

Sub SearchExplorerForSelection()

Dim d As String
Dim searchpath As String
Dim searchlocation As String

Dim PartNumber As Range
Dim GenType As Range
' Cancel = True
d = Selection.Value

Set PartNumber = Selection 'Get desired part number from selected cell
Set GenType = PartNumber.Offset(2) 'Get PN's classification
PartNumberSearch = GenType & "*" & PartNumber 'Set full search keywords

searchpath = "search-ms:displayname=Search%20Results%20in%20" & GenType & "&crumb=filename%3A~" & PartNumberSearch
'copy string from manual search (e.g. my documents replace USERNAME)

searchlocation = "%20OR%20System.Generic.String%3A" & PartNumberSearch & "&crumb=location:Z%3A%5CTest%5CCalibration_Data_Generators%5C" & GenType
If Not d = "" Then
    Call Shell("explorer.exe """ & searchpath & searchlocation, 1)
   'src: https://stackoverflow.com/questions/24376850/open-explorer-search-from-excel-hyperlink

End If

End Sub

我对使用 VBA 很陌生。

标签： excelvba

解决方案

编辑 - 我想我可能将您的问题误读为关于搜索文件内容的问题，但它实际上是关于按文件夹名称搜索。

我认为在这种情况下您最好的选择是使用 Dir() 或 FileSystemObject 循环遍历“根”文件夹下的所有文件夹，并在列表框中向用户返回匹配文件夹名称的列表 - 这可能位于工作表或用户表单。然后他们可以从该列表中进行选择。

Sub Tester2()

    Dim col As Collection, f

    Set col = GetFolderMatches("C:\Users\blahblah\Stuff", "Mail")

    For Each f In col
        Debug.Print f  '<< add to a list for the user to pick from
    Next f
End Sub



'Return a collection of folder paths given a starting folder and a term to search on
'  e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function GetFolderMatches(startFolder As String, nameIncludes As String, _
                    Optional subFolders As Boolean = True) As Collection

    Dim fso, fldr, f, subFldr
    Dim colFolders As New Collection
    Dim colSub As New Collection

    Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder

    Do While colSub.Count > 0
        Set fldr = fso.getfolder(colSub(1))
        colSub.Remove 1
        If LCase(fldr.Name) Like "*" & LCase(nameIncludes) & "*" Then
            colFolders.Add fldr.Path
        End If
        If subFolders Then
            For Each subFldr In fldr.subFolders
                colSub.Add subFldr.Path
            Next subFldr
        End If
    Loop
    Set GetFolderMatches = colFolders
End Function

下面的代码不是您问题的答案，而是将其留在这里，因为它很有趣......

您可以使用 ADO 直接从 VBA 访问 Windows 搜索（在您的 VBA 项目中添加对“Microsoft ActiveX 数据对象 vx.x 库”的引用）

Sub Tester()

    Dim conn As New ADODB.Connection, rs As ADODB.Recordset

    conn.Open "Provider=Search.CollatorDSO;Extended Properties='Application=Windows';"

    Set rs = conn.Execute("SELECT System.ItemPathDisplay " & _
                          " FROM SYSTEMINDEX WHERE " & _
                          " SCOPE = 'C:\Users\blahblah\Desktop\Temp' " & _
                          " and contains('validated')")

    Do While Not rs.EOF
        Debug.Print rs(0).Value
        rs.MoveNext
    Loop

End Sub

基于：http ://www.thejoyofcode.com/Using_Windows_Search_in_your_applications.aspx

推荐阅读