Sub GetTodayFile()
    Dim sFolder As String, sFile$, sResFile$, sFFullName$
    Dim dt As Date
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    sFile = Dir(sFolder & "*.xls*")
    Do While sFile <> ""
        'открываем книгу
        sFFullName = sFolder & sFile
        dt = Int(FileDateTime(sFFullName))
        If dt = Date Then
            sResFile = sFFullName
            Exit Do
        End If
        sFile = Dir
    Loop
    
    If sResFile <> "" Then
        MsgBox "Найден файл, созданный сегодня: '" & sResFile & "'", vbInformation, "www.excel-vba.ru&quot;
    Else
        MsgBox "В выбранной папке нет файлов, созданных сегодня", vbInformation, "www.excel-vba.ru&quot;
    End If
End Sub