Joe said:
There has been discussion way back about a minor problem with Excel
2004. If Excel is opened then closed without doing anything else the
Recent Files list is cleared, There have been two updates since then
but the problem remains after updating to 11.3.3 which I believe is a
January 2007 release. Word 2004 does not have this problem.
I use the following code in an add-in to fix that problem. I put the
add-in in my (alternate) startup folder so that it loads automatically.
Note that this has the added benefit of removing MRU entries that have
been moved to the Trash, since Application.RecentFiles.Add() apparently
won't add files that are in the Trash.
Note also that it creates a folder in your ~:Library:Application Support
folder to store a text file containing the MRU entries.
In the ThisWorkbook code module:
Private Sub Workbook_Open()
RestoreMRU
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
SaveMRU
End Sub
In a regular code module:
Dim msSavePath As String
Public Sub SaveMRU()
Dim nFileNumber As Long
Dim i As Long
Dim sFileName As String
Dim sTemp As String
If bGetFilePath() Then
On Error GoTo ErrorHandler
nFileNumber = FreeFile
sFileName = "MRU" & Format(Now, "yyyymmddhhmmss") & ".txt"
Open msSavePath & sFileName For Output Access Write _
Lock Read Write As #nFileNumber
With Application.RecentFiles
For i = 1 To .Count
Print #nFileNumber, .Item(i).Path
Next i
End With
Close #nFileNumber
'Kill previous files:
sTemp = Dir(msSavePath)
Do While sTemp <> vbNullString
If sTemp Like "MRU##############.txt" Then _
If sTemp <> sFileName Then _
Kill msSavePath & sTemp
sTemp = Dir()
Loop
End If
ResumeHere:
Exit Sub
ErrorHandler:
Debug.Print Now, "SaveMRU: ", Err.Number, Err.Description
Resume ResumeHere
End Sub
Public Sub RestoreMRU()
Dim nFileNumber As Long
Dim nMax As Long
Dim i As Long
Dim sMRUEntry(1 To 9) As String
Dim sFileName As String
On Error GoTo ErrorHandler
If bGetFilePath() Then
sFileName = Dir(msSavePath)
If Not sFileName = vbNullString Then
If sFileName Like "MRU##############.txt" Then
nFileNumber = FreeFile
Open msSavePath & sFileName For Input Access Read _
Lock Read Write As #nFileNumber
Do While Not EOF(nFileNumber)
i = i + 1
Line Input #nFileNumber, sMRUEntry(i)
Loop
Close #nFileNumber
'Add in reverse order...
With Application.RecentFiles
nMax = .Maximum
If nMax < i Then nMax = i
.Maximum = 0
.Maximum = nMax
For i = i To 1 Step -1
.Add sMRUEntry(i)
Next i
End With
End If
End If
End If
ResumeHere:
Exit Sub
ErrorHandler:
Debug.Print Now, "RestoreMRU: ", Err.Number, Err.Description
Resume ResumeHere
End Sub
Private Function bGetFilePath() As Boolean
Dim sPS As String
Dim sPath As String
Dim bResult As Boolean
On Error GoTo ErrorHandler
bResult = True
sPS = Application.PathSeparator
'Create Directory if necessary
sPath = MacScript("(path to home folder as string)") & _
"Library:Application Support"
If Dir(sPath, vbDirectory) = vbNullString Then
MsgBox "Can't find Application Support folder"
bResult = False
Else
sPath = sPath & sPS & "Microsoft Office"
If Dir(sPath, vbDirectory) = vbNullString Then MkDir sPath
sPath = sPath & sPS & "Excel"
If Dir(sPath, vbDirectory) = vbNullString Then MkDir sPath
End If
msSavePath = sPath & sPS
ResumeHere:
bGetFilePath = bResult
Exit Function
ErrorHandler:
bResult = False
Debug.Print Now, "bGetAddress: ", Err.Number, Err.Description
End Function
