' Userform name : frmRecentExcel
' Listbox name : lstRecentExcel
Private Sub UserForm_Activate()
Dim path_name As String, file_name As String, fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
path_name = "C:\Documents and Settings\[COLOR=red]WinblowsME[/color]\Recent\"
file_name = Dir(path_name & "*.xls.lnk")
Do While file_name <> ""
file_name = Get_Target_Path(path_name & file_name)
If fso.FileExists(file_name) Then
lstRecentExcel.AddItem (file_name)
End If
file_name = Dir
Loop
Set fso = Nothing
End Sub
Private Sub lstRecentExcel_Click()
On Error GoTo FILE_OPEN_ERR
Workbooks.Close
Workbooks.Open (lstRecentExcel.List(lstRecentExcel.ListIndex))
Exit Sub
FILE_OPEN_ERR:
MsgBox Err.Number & " " & Err.Description
End Sub
Private Function Get_Target_Path(ByVal file_name As String) As String
Dim obj As Object, shortcut As Object
Set obj = CreateObject("WScript.Shell")
Set shortcut = obj.CreateShortcut(file_name)
Get_Target_Path = shortcut.TargetPath
Set shortcut = Nothing
Set obj = Nothing
End Function