Извлечение последних имен файлов из пути

Question

Я ищу код VBA Excel, который возвращает имя файла из путей (я упомяну их).

В файле Excel один из столбцов будет иметь имена файлов (например: - lgd_00, lgf_01), и эти файлы будут находиться в путях (5 или 6 путей), которые я упомяну. Код должен искать имя файла в пути и извлекать последнее имя файла и копировать рядом с ним.

например, в a1 - a20 есть имена файлов. Рассмотрим, что у "a1" есть "lgd_00", но в указанном мной пути будет файл "lgd_00", а после обновления он станет "lgd_01". Здесь «lgd_01» - самый последний файл, поэтому код должен извлечь «lgd_01» и скопировать его в столбец (b1) «lgd_00» в excel. если «lgd_00» является последним файлом, он должен скопировать его.

, возможно, приложенное поможет.

Благодарим вас за помощь.

Спасибо

Sub LatestFileWithName()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strPath As String
Dim strName As String
Dim varDate As Variant
Dim strFind As String

Dim r As Long, ws As Worksheet
Set ws = Sheets("Sheet1")


strPath = ""

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)


For r = ws.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1

    If ws.Range("A" & r).Value = Left(objectFile, 20) Then

       strFind = ws.Range("A" & r).Value

For Each objFile In objFolder.Files
If InStr(1, objFile.Name, strFind, vbTextCompare) Then
If objFile.DateLastModified > varDate Then
strName = objFile.Name
varDate = objFile.DateLastModified

If Len(strName) = 0 Then
strName = "None found"
Else
strName = strName & " - is latest file - " & varDate
End If

  ws.Range("B" & r).Value = strName
                r = r + 1

End If
End If




  Next 'objFile
     End If
Next r

Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
End Sub

Answer 1

Я не могу разобрать, что вы хотите, но я запрограммировал что-то, что должно быть рядом. Пожалуйста, попробуйте.

Sub LatestFileWithName()

    Dim SourceFolder As String
    Dim Ws As Worksheet
    Dim ItemName As String
    Dim Fn As String                            ' File name
    Dim Latest As String
    Dim Sp() As String
    Dim R As Long

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then                      ' if OK is pressed
            SourceFolder = .SelectedItems(1)
        End If
    End With

    If SourceFolder <> "" Then                  ' a folder was chosen
        Set Ws = Worksheets("Sheet1")
        With Ws
            For R = .Cells(.Rows.Count, "A").End(xlUp).Row To 2 Step -1
                ' read the file name from Sheet1!A:A
                '  this name has no path and no extension (like "lgh_00")
                ItemName = Trim(.Cells(R, "A").Value)
                If Len(ItemName) Then           ' skip if blank
                    Latest = ""
                    ItemName = Split(ItemName, "_")(0)

                    ' search for all items in the folder that have the same name
                    Fn = Dir(SourceFolder & "\" & ItemName & "*")
                    Do While Len(Fn) > 0
                        ' remember the largest one (e.g. 2 is larger than 1)
                        If Fn > Latest Then Latest = Fn
                        Fn = Dir
                    Loop

                    Sp = Split(Latest, ".")     ' remove the extension
                    If UBound(Sp) Then ReDim Preserve Sp(UBound(Sp) - 1)
                    .Cells(R, "B").Value = Join(Sp, ".")
                End If
            Next R
        End With
    End If
End Sub

В Sheet1! A: A этот макрос ожидает имена файлов, такие как "lgd_00". Подчеркивание используется в коде. Там не должно быть расширения и пути. Когда макрос запускается, вы попадаете в Windows FolderPicker Explorer, где вы выбираете папку. После этого макрос найдет последнюю версию каждого файла в A: A и напишет имя в B: B.