时间戳

首页 > 解决方案 > 从路径中提取最新的文件名

excel - 从路径中提取最新的文件名

问题描述

我正在寻找一个从路径返回文件名的 VBA Excel 代码（我会提到它们）。

在 excel 文件中，其中一列将具有文件名（例如：lgd_00、lgf_01），这些文件将位于我将提到的路径（5 或 6 个路径）中。代码应该在路径中搜索文件名并提取最新的文件名并复制到它旁边。

例如在 a1 到 a20 中有文件名。考虑“a1”有“lgd_00”，但在我提到的路径中将是“lgd_00”文件，更新后它变成了“lgd_01”。这里“lgd_01”是最新文件，所以代码应该提取“lgd_01”并将其复制到excel中“lgd_00”的列（b1）旁边。如果“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

标签： excelvba

解决方案

我不太清楚你想要什么，但我编写了一些应该在附近的东西。请尝试一下。

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，您可以在其中选择一个文件夹。此后，宏将在 A:A 中找到每个文件的最新版本，并在 B:B 中写入名称。

推荐阅读