VBA实用小程序62： 获取文件夹中最新保存的工作簿

'获取指定文件夹中除当前工作簿外
'最新保存的工作簿的文件名
Function GetLastWorkbook(sPath As String) As String
    Dim wb As Workbook
    Dim sFile As String
    Dim fs As Object
    Dim objFile As Object
    Dim strMsg As String
    Dim tm As Date
    Dim sName As String
   
    '如果文件路径中没有反斜杠则添加
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
   
    '获取文件
    sFile = Dir(sPath & "*.xls*")
    Set fs =CreateObject("Scripting.FileSystemObject")
    SetobjFile = fs.GetFile(sPath & sFile)
    tm = 0
       
    '遍历文件夹中的文件
    Do While sFile <> ""
        Set objFile = fs.GetFile(sPath &sFile)
        '如果文件不是本代码所在的工作簿且文件最近保存的日期大于上一文件保存的日期
        If objFile.Name <>ActiveWorkbook.Name And objFile.DateLastModified > tm Then
           '将该文件赋值给变量
            tm = objFile.DateLastModified
           '将该文件名赋值给变量
            sName = objFile.Name
        End If
        '下一个文件
        sFile = Dir
    Loop
   
    '返回值
    GetLastWorkbook = sName
End Function

Sub test()
    Dim wbName As String
   
    wbName =GetLastWorkbook(ActiveWorkbook.Path)
    Debug.Print wbName
End Sub