我如何获得此程序以按名称的日期按日期打开最后一个修改的日期工作簿

Question

我的文件都被命名为 myFile053017.xls and myFile052517.xls 。

我试图抓住名称中的日期，并将其用作最后修改的日期，以防万一有人打开并保存其中一个工作簿

'Force the explicit declaration of variables
Option Explicit
Sub OpenLatestFile()
    'Declare the variables
    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LMD As Date
    
    'Specify the path to the folder
    MyPath = "M:UsersDanAccessDiscontinueQueryDiscontinueQuerySave"
    
    'Make sure that the path ends in a backslash
    If Right(MyPath, 1) <> "" Then MyPath = MyPath & ""
    
    'Get the first Excel file from the folder
    MyFile = Dir(MyPath & "*.xls", vbNormal)
    
    'If no files were found, exit the sub
    If Len(MyFile) = 0 Then
        MsgBox "No files were found...", 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 = FileDateTime(MyPath & MyFile)
        
        '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 & LatestFile
End Sub

Answer 1

如果您只想查看文件名来确定"最新"文件，则仅在完整路径上调用FileDateTime，而是仅在文件名上调用函数。

您需要对您的文件名进行一些调整，这并不如您的问题所示。

'MyFile053017.xls >> 5/30/2017
Function NewFileDateTime(sFile As String)
    NewFileDateTime = DateSerial(2000 + Mid(sFile, 11, 2), _
                                        Mid(sFile, 7, 2), _
                                        Mid(sFile, 9, 2))
End Function

Answer 2

我将使用正则表达式添加另一个解决方案。蒂姆的解决方案更简洁，但正则表达式避免计算数字的位置(如果将来文件名是否会更改(。该模式只需搜索六个数字，然后使它们的组将其馈送到DateSerial函数：

Function FileDateTime(file_name$)
    With CreateObject("VBScript.RegExp")
        .Pattern = "(d{2})(d{2})(d{2})"
        With .Execute(file_name)(0)
            FileDateTime = DateSerial(2000 + .SubMatches(2), .SubMatches(0), .SubMatches(1))
        End With
    End With
End Function