Поиск файла и обратный путь

Question

Мне нужны некоторые идеи здесь ... У меня есть столбец с именами файлов. У меня есть папка, в которой есть все файлы Excel. Можно ли связать оба этих и получить путь к файлу в соседней ячейке?

например: у меня есть значение «AAA», «BBB» и т. Д. В столбце A1, A2, аналогично, у меня есть набор файлов Excel в папке с именем AAA.xlsx, BBB.xlsx.

Я каждый раз вручную выбираю путь к папке с макросом.

Наконец, сравнивая значение ячейки в столбце A и имя файла в папке, путь к файлу должен отображаться в столбце B для соответствующих элементов. .

Answer 1

После вашего последнего редактирования это должно работать:

Sub SetFullPath()

MyPath = "C:\Insert path of the folder where you have the files here\"
For Each cell In Range("B1:B100")'Customize your range
If Len(Dir(MyPath & Range("A" & cell.Row).Value & ".xlsx")) = 0 Then
cell.Value = "File Not Found"
Else: cell.Value = MyPath & Range("A" & cell.Row).Value & ".xlsx"
End If
Next

End Sub

Дайте мне знать, если что-то нужно изменить.

Answer 2

Этот саб (return_paths) должен это сделать. Используется функция GivePath.

Sub return_paths()
  Dim sSearchPath As String: sSearchPath = "C:\Temp"
  Dim oFSO As Object
  Dim i As Long
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  For i = 1 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Cells(i, 2) = GivePath(ActiveSheet.Cells(i, 1), oFSO.GetFolder(sSearchPath))
  Next
End Sub


Private Function GivePath(sName As String, oDir As Object, Optional ByRef blnFound As Boolean) As String
  Dim f As Object
  Dim sf As Object

  If blnFound Then Exit Function

  For Each f In oDir.Files
    If f.Name = sName Then
      GivePath = f.Path
      blnFound = True
    End If
    If blnFound Then Exit Function
  Next

  For Each sf In oDir.SubFolders
    GivePath = GivePath(sName, sf, blnFound)
    If blnFound Then Exit Function
  Next

  If GivePath = "" Then GivePath = "The file was not found"

End Function

После запуска результат выглядит так:

Answer 3

Пожалуйста, найдите решение, которое я получил от объединения всех результатов. Спасибо, парни. вы все классные !!!

Sub FolderDetails()
Dim FSO As New FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim rRng As Range, rCl As Range
Dim sFolder As String
''// Open the select folder prompt
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
sFolder = .SelectedItems(1)
End If
End With
Set rRng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
For Each rCl In rRng
If FSO.FileExists(sFolder & Application.PathSeparator & rCl.Value & ".xlsx") Then
rCl.Offset(, 1).Value = sFolder
Else: rCl.Offset(, 1).Value = "The File Does Not Exist"
End If
Next rCl
End Sub