Question

文件夹中有一些exel文件。目的是搜索日期最高的文件（格式：Fundings“＆Format（LMD，” DDMMYY“）＆” .xls）并打开它。例如。文件名是Fundings 270818，Funders 110618，最近的是第一个。下面的代码遇到“ MyFile = Dir（MyPath，vbNormal）”为空的错误。

 Dim MyPath  As String
 Dim MyFile  As String
 Dim LatestFile  As String
 Dim LatestDate  As Date
 Dim LMD  As Date

 LMD = Date

 'Specify the path to the folder
 MyPath = "C:\Users\topal\Desktop\Spreaddeterminierung\Fundings " & Format(LMD, "DDMMYY") & ".xls"



 'Get the first Excel file from the folder
 MyFile = Dir(MyPath, vbNormal)

 'If no files were found, exit the sub
 If Len(MyFile) = 0 Then
     MsgBox "No Sir", vbExclamation
     Exit Sub
 End If

 'Loop through each Excel file in the folder
 Do While Len(MyFile) > 0

     'Assign the date/time of the current file to a variable
     LMD = Date

     'If the date/time of the current file is greater than the latest
     'recorded date, assign its filename and date/time to variables
     If LMD > LatestDate Then
         LatestFile = MyFile
         LatestDate = LMD
     End If

     'Get the next Excel file from the folder
     MyFile = Dir

 Loop

 'Open the latest file
 Workbooks.Open MyPath

 End Sub

Answer 1

您可以循环文件夹，提取字符串的日期部分，并存储最大值以用于识别文件。以下内容还应用了"xlsx"的文件掩码，您可以删除或更改它。它使用正则表达式根据您指定的模式查找合格的文件名。

Option Explicit

Public Sub GetLastestDateFile()
    Dim FileSys As Object, objFile As Object, myFolder As Object, strFile As String, dteFile As Long
    Const myDir As String = "C:\Users\User\Desktop\TestFolder"
    Set FileSys = CreateObject("Scripting.FileSystemObject")
    Set myFolder = FileSys.GetFolder(myDir)

    Dim fileName As String, tempDate As Long, fileMask As String

    dteFile = 0: fileMask = "xlsx"
    For Each objFile In myFolder.Files
        If FileSys.GetExtensionName(objFile.Path) = fileMask And ValidateFile(Split(objFile.Name, ".xlsx")(0)) Then
            tempDate = GetDateFromFileName(objFile.Name)
            Dim pseudoDate As String
            pseudoDate = ReArrange(tempDate)
            If pseudoDate > dteFile Then dteFile = pseudoDate
        End If
    Next objFile
    If Not tempDate = 0 Then Workbooks.Open (myDir & "\" & "Fundings " & Format$(ReArrange(dteFile), "000000") & "." & fileMask)
End Sub

Public Function ReArrange(ByVal tempDate As String) As String
    tempDate = Format$(tempDate, "000000")
    ReArrange = Format$(Right$(tempDate, 2), "00") & Format$(Mid$(tempDate, 3, 2), "00") & Format$(Left$(tempDate, 2), "00")
End Function

Public Function ValidateFile(ByVal fileName As String) As Boolean
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "Fundings\s\d{6}$"
        ValidateFile = .test(fileName)
    End With
End Function

Public Function GetDateFromFileName(ByVal fileName As String) As Date
    On Error GoTo errhand
    GetDateFromFileName = Split(Split(fileName, "Fundings ")(1), ".")(0)
    Exit Function
errhand:
    GetDateFromFileName = 0
End Function

正则表达式：

尝试使用正则表达式here。

说明：

Fundings\s\d{6}$
/
gm

Fundings从字面上匹配字符Fundings（区分大小写）

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

\d{6}匹配一个数字（等于[0-9]）

{6}量词-精确匹配6次

$在行尾声明位置

Answer 2

您的循环来自：

“遍历文件夹“ Do While Len（MyFile）> 0”中的每个Excel文件

 'Assign the date/time of the current file to a variable
 LMD = Date

 'If the date/time of the current file is greater than the latest
 'recorded date, assign its filename and date/time to variables
 If LMD > LatestDate Then
     LatestFile = MyFile
     LatestDate = LMD
 End If

 'Get the next Excel file from the folder
 MyFile = Dir

这是什么也没做，这就是为什么您得到空值或不执行任何操作的原因。

我建议您彻底改变您的看法，并尝试实施以下方法：

vba search through a folder and select files by name

VBA打开文件夹中的最新文件

2 个答案: