Excel 如何根据文件名模式使用最新文件？

我有一个包含Excel文件的文件夹，保存格式如下：

2018.01 final.xlsx 2018.02 final.xlsx 2018.03最终xlsx。 等 我想执行VLOOKUP，根据文件名模式查找最近的文件。今天将是2018年8月的最终xlsx

如果8月份的文件尚未保存，我希望使用前一个月，即2018年7月7日final.xlsx

以下代码将打开最新的文件。我想根据模式的最新文件，而不打开它

  fromPath = Sheets("Open latest file").Range("B5")
  fromPath2 = Sheets("Open latest file").Range("B6")

  If Dir(fromPath) = "" Then

    Workbooks.Open (fromPath2)

  Else

    Workbooks.Open (fromPath)

  End If

End Sub

---

幸运的是，我已经有了一个我喜欢使用的函数，它基本上满足了您的需求：

Function GetMostRecentExcelFile(ByVal myDirectory As String, ByVal filePattern As String) As String

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim myFolder As Object
    Set myFolder = fso.getfolder(IIf(Right(myDirectory, 1) = "\", myDirectory, myDirectory & "\"))

    Dim currentDate As Date
    Dim fname As String

    Dim currentFile As Object
    For Each currentFile In myFolder.Files
        If (currentDate = CDate(0) Or currentFile.DateCreated > currentDate) And currentFile.name Like filePattern _
            And InStr(LCase$(currentFile.name), ".xlsx") > 0 And InStr(currentFile.name, "~$") = 0 Then

            currentDate = currentFile.DateCreated
            fname = currentFile.name

        End If
    Next currentFile

    GetMostRecentExcelFile = fname

End Function

它将在指定的myDirectory中循环查找与您提供的filePattern匹配的任何文件，并返回包含与所述模式匹配的最新创建的文件的文件

注意：它不会根据文件名选择文件，只根据文件的创建日期

以下是您最有可能使用它解决问题的方法：

Sub Main()

    Dim pattern As String
    pattern = "*20##.## final*"

    Dim path As String
    path = sheets("Open latest file").Range("B5").Value2

    Dim filename As String
    filename = GetMostRecentExcelFile(path, pattern)

    If Len(filename) = 0 Or Len(Dir(filename)) = 0 Then
        path = sheets("Open latest file").Range("B6").Value2
        filename = GetMostRecentExcelFile(path, pattern)
    End If

    If Len(filename) > 0 Then
        Workbooks.Open (IIf(Right(path, 1) = "\", path, path & "\") & filename)
    Else
        MsgBox "No files found matching pattern"
    End If

End Sub

---

幸运的是，我已经有了一个我喜欢使用的函数，它基本上满足了您的需求：

Function GetMostRecentExcelFile(ByVal myDirectory As String, ByVal filePattern As String) As String

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim myFolder As Object
    Set myFolder = fso.getfolder(IIf(Right(myDirectory, 1) = "\", myDirectory, myDirectory & "\"))

    Dim currentDate As Date
    Dim fname As String

    Dim currentFile As Object
    For Each currentFile In myFolder.Files
        If (currentDate = CDate(0) Or currentFile.DateCreated > currentDate) And currentFile.name Like filePattern _
            And InStr(LCase$(currentFile.name), ".xlsx") > 0 And InStr(currentFile.name, "~$") = 0 Then

            currentDate = currentFile.DateCreated
            fname = currentFile.name

        End If
    Next currentFile

    GetMostRecentExcelFile = fname

End Function

它将在指定的myDirectory中循环查找与您提供的filePattern匹配的任何文件，并返回包含与所述模式匹配的最新创建的文件的文件

注意：它不会根据文件名选择文件，只根据文件的创建日期

以下是您最有可能使用它解决问题的方法：

Sub Main()

    Dim pattern As String
    pattern = "*20##.## final*"

    Dim path As String
    path = sheets("Open latest file").Range("B5").Value2

    Dim filename As String
    filename = GetMostRecentExcelFile(path, pattern)

    If Len(filename) = 0 Or Len(Dir(filename)) = 0 Then
        path = sheets("Open latest file").Range("B6").Value2
        filename = GetMostRecentExcelFile(path, pattern)
    End If

    If Len(filename) > 0 Then
        Workbooks.Open (IIf(Right(path, 1) = "\", path, path & "\") & filename)
    Else
        MsgBox "No files found matching pattern"
    End If

End Sub

---

我真的很喜欢@Marcucciboy2给你的答案，但如果你不能相信最后创建的文件实际上就是你需要的文件，你可以使用如下内容：

Sub GetFile()

Dim YR As Long, MNTH As Long
Dim FPath As String, SearchFile As String

FPath = "U:\Test\"

For YR = Year(Now()) To 1 Step -1
    For MNTH = 12 To 1 Step -1
        If MNTH < 10 Then
            SearchFile = FPath & YR & ".0" & MNTH & " final.xlsx"
        Else
            SearchFile = FPath & YR & "." & MNTH & " final.xlsx"
        End If
        If Dir(SearchFile) <> "" Then
            Workbooks.Open (SearchFile)
            Exit Sub
        End If
    Next MNTH
Next YR

End Sub

---

此选项的另一个优点是，它不必循环浏览所有文件，从而节省了一些时间。

我非常喜欢@Marccucciboy2给出的答案，但如果您不能相信最后创建的文件实际上就是您需要的文件，您可以使用如下内容：

Sub GetFile()

Dim YR As Long, MNTH As Long
Dim FPath As String, SearchFile As String

FPath = "U:\Test\"

For YR = Year(Now()) To 1 Step -1
    For MNTH = 12 To 1 Step -1
        If MNTH < 10 Then
            SearchFile = FPath & YR & ".0" & MNTH & " final.xlsx"
        Else
            SearchFile = FPath & YR & "." & MNTH & " final.xlsx"
        End If
        If Dir(SearchFile) <> "" Then
            Workbooks.Open (SearchFile)
            Exit Sub
        End If
    Next MNTH
Next YR

End Sub

Sub FileFinder() 

Dim strFile As String, strKey As String
Dim lngMax As Long, lngNumber As Long
Dim objDict As Object

Set objDictionary = CreateObject("scripting.dictionary")
intMax = 0
    strFile = Dir("C:\Users\Documents\test\*.xlsx")
    Do While Len(strFile) > 0

        intNumber = f_NumberExtractor(strFile)
        If lngMax < lngNumber Then
            lngMax = lngNumber
        End If

        If objDictionary.exists(lngNumber) = False Then
                objDictionary.Add lngNumber, strFile
         End If
        strFile = Dir
    Loop

    MsgBox objDictionary(lngMax)

End Sub

Public Function f_NumberExtractor(ByVal str As String) As Long
'Regular expression function to get rid of non-numeric signs
Dim objRegEx As Object
Dim lngResult As Long

Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "\D"
objRegEx.Global = True


lngResult = objRegEx.Replace(str, vbNullString) * 1
f_NumberExtractor = lngResult

End Function

---

此选项的另一个优点是，它不必在所有文件中循环，从而节省了一些时间。

您可以尝试使用正则表达式对给定文件夹中的文件进行模式匹配。执行一点字符串操作，只保留字符串的日期部分，然后使用sortedList对符合条件的文件名进行排序。然后从排序列表中选择最后一项作为您的最新文件名

Sub FileFinder() 

Dim strFile As String, strKey As String
Dim lngMax As Long, lngNumber As Long
Dim objDict As Object

Set objDictionary = CreateObject("scripting.dictionary")
intMax = 0
    strFile = Dir("C:\Users\Documents\test\*.xlsx")
    Do While Len(strFile) > 0

        intNumber = f_NumberExtractor(strFile)
        If lngMax < lngNumber Then
            lngMax = lngNumber
        End If

        If objDictionary.exists(lngNumber) = False Then
                objDictionary.Add lngNumber, strFile
         End If
        strFile = Dir
    Loop

    MsgBox objDictionary(lngMax)

End Sub

Public Function f_NumberExtractor(ByVal str As String) As Long
'Regular expression function to get rid of non-numeric signs
Dim objRegEx As Object
Dim lngResult As Long

Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "\D"
objRegEx.Global = True


lngResult = objRegEx.Replace(str, vbNullString) * 1
f_NumberExtractor = lngResult

End Function

Option Explicit
Public Sub GetLastestFile()
    Const PATH As String = "C:\Users\User\Desktop\Testing"
    Dim fso As Object, oFolder As Object, oFile As Object, list As Object, tempString As String
    Set list = CreateObject("System.Collections.SortedList")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder(PATH)

    For Each oFile In oFolder.Files
        If IsFound(oFile.Name) Then
            tempString = Replace$(Left$(oFile.Name, 7), ".", vbNullString)
            With list
                If Not .contains(tempString) Then
                    .Add tempString, vbNullString
                End If
            End With
        End If
    Next
     Debug.Print list.Getkey(list.Count - 1)
End Sub
Public Function IsFound(ByVal inputString As String) As Boolean
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "\d{4}.\d{2}\sfinal.xlsx"
        IsFound = .test(inputString) 
    End With
End Function

你可以试试正则表达式

正则表达式解释：

\d{4}.\d{2}\sfinal.xlsx

\d{4}匹配一个等于[0-9]的数字 {4} 量词-精确匹配4次

。匹配除行终止符以外的任何字符

\d{2}匹配一个等于[0-9]的数字 {2} 量词-精确匹配2次

\s匹配任何等于[\r\n\t\f\v]的空白字符

final匹配字符final，区分大小写 . 匹配除行终止符以外的任何字符 xlsx匹配字符xlsx，严格区分大小写

使用类

更好的做法是为正则表达式实现一个类，该类包含一个IsFound方法。这将避免不断创建和销毁regex对象。而是使用类实例化创建它，然后根据需要调用方法

如果创建名为RegexFileMatch的类，请输入以下代码：

Option Explicit
Private re As Object
Private Sub Class_Initialize()
    Set re = CreateObject("VBScript.RegExp")
End Sub

Public Function IsFound(ByVal inputString As String) As Boolean
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "\d{4}.\d{2}\sfinal.xlsx"
        IsFound = .test(inputString)
    End With
End Function

然后将标准模块中的调用代码更改为：

Option Explicit
Public Sub GetLastestFile()
    Const PATH As String = "C:\Users\User\Desktop\Testing"
    Dim fso As Object, oFolder As Object, oFile As Object, list As Object, tempString As String
    Set list = CreateObject("System.Collections.SortedList")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder(PATH)
    Dim regex As New regexFileMatch
    For Each oFile In oFolder.Files
        If regex.IsFound(oFile.Name) Then
            tempString = Replace$(Left$(oFile.Name, 7), ".", vbNullString)
            With list
                If Not .contains(tempString) Then
                    .Add tempString, vbNullString
                End If
            End With
        End If
    Next
     Debug.Print list.Getkey(list.Count - 1)
End Sub

---

这将降低成本。

您可以尝试使用正则表达式对给定文件夹中的文件进行模式匹配。执行一点字符串操作，只保留字符串的日期部分，然后使用sortedList对符合条件的文件名进行排序。然后从排序列表中选择最后一项作为您的最新文件名

Option Explicit
Public Sub GetLastestFile()
    Const PATH As String = "C:\Users\User\Desktop\Testing"
    Dim fso As Object, oFolder As Object, oFile As Object, list As Object, tempString As String
    Set list = CreateObject("System.Collections.SortedList")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder(PATH)

    For Each oFile In oFolder.Files
        If IsFound(oFile.Name) Then
            tempString = Replace$(Left$(oFile.Name, 7), ".", vbNullString)
            With list
                If Not .contains(tempString) Then
                    .Add tempString, vbNullString
                End If
            End With
        End If
    Next
     Debug.Print list.Getkey(list.Count - 1)
End Sub
Public Function IsFound(ByVal inputString As String) As Boolean
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "\d{4}.\d{2}\sfinal.xlsx"
        IsFound = .test(inputString) 
    End With
End Function

你可以试试正则表达式

正则表达式解释：

\d{4}.\d{2}\sfinal.xlsx

\d{4}匹配一个等于[0-9]的数字 {4} 量词-精确匹配4次

。匹配除行终止符以外的任何字符

\d{2}匹配一个等于[0-9]的数字 {2} 量词-精确匹配2次

\s匹配任何等于[\r\n\t\f\v]的空白字符

final匹配字符final，区分大小写 . 匹配除行终止符以外的任何字符 xlsx匹配字符xlsx，严格区分大小写

使用类

更好的做法是为正则表达式实现一个类，该类包含一个IsFound方法。这将避免不断创建和销毁regex对象。而是使用类实例化创建它，然后根据需要调用方法

如果创建名为RegexFileMatch的类，请输入以下代码：

Option Explicit
Private re As Object
Private Sub Class_Initialize()
    Set re = CreateObject("VBScript.RegExp")
End Sub

Public Function IsFound(ByVal inputString As String) As Boolean
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "\d{4}.\d{2}\sfinal.xlsx"
        IsFound = .test(inputString)
    End With
End Function

然后将标准模块中的调用代码更改为：

Option Explicit
Public Sub GetLastestFile()
    Const PATH As String = "C:\Users\User\Desktop\Testing"
    Dim fso As Object, oFolder As Object, oFile As Object, list As Object, tempString As String
    Set list = CreateObject("System.Collections.SortedList")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder(PATH)
    Dim regex As New regexFileMatch
    For Each oFile In oFolder.Files
        If regex.IsFound(oFile.Name) Then
            tempString = Replace$(Left$(oFile.Name, 7), ".", vbNullString)
            With list
                If Not .contains(tempString) Then
                    .Add tempString, vbNullString
                End If
            End With
        End If
    Next
     Debug.Print list.Getkey(list.Count - 1)
End Sub

---

这将降低成本。

简化版，归功于@QHarr。。 我的文件名为

IPG媒体品牌-更新-2020-10-12.txt

IPG媒体品牌-更新-2021-10-12.txt

所以改变te RegEx.Pattern=\d{4}-0？[1-9 ]|1[012]-0？[1-9]|[12][0-9]|3[01]*以满足您的需要

Function GetLastestFile(path)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder(path)
        f = 0
        For Each oFile In oFolder.Files
            If CDate(FileDate(oFile.Name)) > f Then
                last= oFile.Name
                f = CDate(fechArchivo(oFile.Name))
            End If
        Next
    GetLastestFile = last
End Function

Function FileDate(inputString)
    Dim re As New RegExp
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "\d{4}\-(0?[1-9]|1[012])\-(0?[1-9]|[12][0-9]|3[01])*"
        fechArchivo = .Execute(inputString)(0)
    End With
End Function

---

简化版，归功于@QHarr。。 我的文件名为

IPG媒体品牌-更新-2020-10-12.txt

IPG媒体品牌-更新-2021-10-12.txt

因此，更改te RegEx.Pattern=\d{4}-0？[1-9]|1[012]-0？[1-9]|[12][0-9]|3[01]*以满足您的需要

Function GetLastestFile(path)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder(path)
        f = 0
        For Each oFile In oFolder.Files
            If CDate(FileDate(oFile.Name)) > f Then
                last= oFile.Name
                f = CDate(fechArchivo(oFile.Name))
            End If
        Next
    GetLastestFile = last
End Function

Function FileDate(inputString)
    Dim re As New RegExp
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "\d{4}\-(0?[1-9]|1[012])\-(0?[1-9]|[12][0-9]|3[01])*"
        fechArchivo = .Execute(inputString)(0)
    End With
End Function

---

---

请包括您迄今为止的尝试，包括您进行的研究，并解释哪些不起作用。请参阅edit@qhari don't think you save您的edit现在应该在那里。谢谢你的帮助，伙计，请包括你迄今为止的尝试，包括你进行的研究，并解释什么不起作用。请参阅edit@qhari不认为你保存了你的edit现在应该在那里。感谢你们的帮助，伙计们+1非常好@Marcucciboy2。但如果实际上2018.08.xlsx是您想要打开的最新文件，但基于creationdate，可能是因为检测到并打开了2017.01.xlsx的编辑，该怎么办？或者我不确定创建的日期是否不受编辑的影响？或者，如果2018.07.xlsx仅仅是在2018.08.xlsx之后创建的呢？@JvdV很好的观点-我可以调整模式，但同样类型的问题可能再次出现。我想说，我不确定谁应该信任文件名或文件属性。我非常感谢您的宝贵帮助！很抱歉提出了一个愚蠢的问题，但是我如何在vba中定义filepattern？谢谢again@Marcucciboy2，是的，我真的认为使用从文件创建的日期很好。唯一的缺点是你必须相信没有人会摆弄这些文件，而最新日期的文件实际上是最接近你当前月份的文件。否则我认为这是一个很酷的解决方案。有了一个小的旁注，你应该有一个更适合未来的20。OP正在根据问题中提供的信息寻找.xlsx。请把它看作是积极的批评M:@JvdV我正要说哇，这是未来的证明，直到我意识到它实际上是哪一年…+1非常好@Marcucciboy2。但如果实际上2018.08.xlsx是您想要打开的最新文件，但基于creationdate，可能是因为检测到并打开了2017.01.xlsx的编辑，该怎么办？或者我不确定创建的日期是否不受编辑的影响？或者，如果2018.07.xlsx仅仅是在2018.08.xlsx之后创建的呢？@JvdV很好的观点-我可以调整模式，但同样类型的问题可能再次出现。我想说，我不确定谁应该信任文件名或文件属性。我非常感谢您的宝贵帮助！很抱歉提出了一个愚蠢的问题，但是我如何在vba中定义filepattern？谢谢again@Marcucciboy2，是的，我真的认为使用从文件创建的日期很好。唯一的缺点是你必须相信没有人会摆弄这些文件，而最新日期的文件实际上是最接近你当前月份的文件。否则我认为这是一个很酷的解决方案。有了一个小的旁注，你应该有一个更适合未来的20。OP正在根据问题中提供的信息寻找.xlsx。请把它当作积极的批评M:@JvdV我正要说哇，这是未来的证明，直到我意识到它实际上是哪一年…谢谢你的帮助！！谢谢你的帮助！！