根据单元格值检索文件夹路径（将单元格值与目录中的文件夹匹配）

Question

感谢大家对我最后一个问题的帮助

前面的代码根据单元格内容查找文件名。也许可以稍微编辑一下以适应这个新要求？

    Sub ParseFiles()
  Dim sh As Worksheet, lastRow As Long, i As Long
  Const foldPath As String = "C:\Users\User1\Downloads\Test*"
  Set sh = ActiveSheet
  lastRow = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
  For i = 2 To lastRow
        sh.Range("B" & i).Value = GetFilePath(foldPath, sh.Range("A" & i).Value)
  Next
End Sub

Function GetFilePath(dirFolder As String, strToFind As String) As String
     GetFilePath = Dir(dirFolder & "*" & strToFind & "*.*")
End Function

我想查找目录中是否存在文件夹，该文件夹可能位于该目录的子文件夹中。文件夹名称前面或后面可能有字符，不会与单元格值完全匹配，但它会包含单元格值。例子：文件夹名称为 'customer 601892 20220105' 但单元格值为“601892”

这里有一个目录（测试），我在其中根据 A1、A2 等的内容搜索文件夹名称是否存在...如果存在，我想要 B1、B2 中的输出使用文件夹路径和文件夹名称。

这是理想的输出。

Answer 1

请尝试下一种方法。由于您不能在两个不同的循环中使用 Dir，因此在 Sub 中我将使用“Scripting.FileSystemObject”在主文件夹子文件夹之间循环：

Sub extractSubfolderPathFromSubfolders()
    Dim sh As Worksheet, lastRow As Long, i As Long, fldName As String
    Dim FSO As Object, fld As Object, subFld As Object
    Const foldPath As String = "C:\Users\User1\Downloads\Test\"
    
    Set sh = ActiveSheet
    lastRow = sh.Range("A" & sh.rows.count).End(xlUp).row
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fld = FSO.GetFolder(foldPath)
    
    For i = 2 To lastRow
        For Each subFld In fld.SubFolders
            fldName = getFoldPath(CStr(subFld), sh.Range("A" & i).value)
            If fldName <> "" Then
                sh.Range("B" & i).value = subFld & "\" & fldName
            End If
        Next
    Next i
End Sub

还有一个函数能够 return 知道其部分名称的目录。它由上面的子调用：

Function getFoldPath(dirFolder As String, strToFind As String) As String
    Dim fldName As String
    If Right(dirFolder, 1) <> "\" Then dirFolder = dirFolder & "\"
    fldName = Dir(dirFolder & "*" & strToFind & "*", vbDirectory)
    Do While fldName <> ""
        If fldName <> "." And fldName <> ".." Then
            ' Use bitwise comparison to make sure dirFolder is a directory.
            If (GetAttr(dirFolder & fldName) And vbDirectory) = vbDirectory Then
                getFoldPath = fldName: Exit Function
            End If
        End If
        fldName = Dir
    Loop
End Function

我现在需要关闭计算机。如果某些东西不能按您的需要工作，请尝试解释原因。明天我会修改代码...

根据单元格值检索文件夹路径（将单元格值与目录中的文件夹匹配）

Retrieve Folder path based on cell value (match cell value to folder in directory)

excel

vba