Macro to delete "unpinned" recent files

[Geoff Budd]

I have the following macro to remove all the recently open file names (except
those
that are "pinned") from the Office Button in Excel 2007 - kindly supplied by
one of the experts in these forums:

Sub ClearMRU_NotPinned()
Dim rFile As RecentFile
Dim WSHShell, RegKey, rKeyWord
Set WSHShell = CreateObject("WScript.Shell")
RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\File MRU\"
For Each rFile In Application.RecentFiles
rKeyWord = WSHShell.RegRead(RegKey & "Item " & rFile.Index)
If InStr(1, rKeyWord, "[F00000000]") Then
rFile.Delete
End If
If InStr(1, rKeyWord, "[F00000002]") Then
rFile.Delete
End If
Next rFile
End Sub

However, when I run it, I get the following error message:

Run-time error '1004'
Application-defined or object-defined error

The debug highlights the statement:
rKeyWord = WSHShell.RegRead(RegKey & "Item " & rFile.Index)

Has anybody got any ideas on what I need to do to make this work?

(P.S. I had a recent thread for this, but it dried up after a couple of
responses, so I'm opening it again from where it left off, in the hope of
resolving this problem).

Many thanks.

 

[p45cal]

I have the following macro to remove all the recently open file names
(except
those
that are "pinned") from the Office Button in Excel 2007 - kindly
supplied by
one of the experts in these forums:

Sub ClearMRU_NotPinned()
[snipped]

I think it's because you're running *down* the list, deleting as you go
and the list gets shorter.

A bit like when you run *down* say 10 rows in a sheet with vba,
conditionally deleting entire rows as you go (resulting in the lower
rows moving up), and finding that some rows that should have been
deleted aren't and that you've overshot the 10 at the bottom. The
solution is to work *up* the rows.

I stepped through your code, allowing it to delete a few and it worked
fine. But I only have 17 under -Show this number of recent documents- in
Excel's advanced options, whereas in the registry there were some 35
entries. As I deleted some, the others moved up in the Office button, so
I could still see 17 there. Only when I allowed the macro to delete
sufficient files so there were fewer than 17 left did I manage to
reproduce your error message.

So it's a matter of running *up* throught the list.. but which list?
The bigger registry list, or the (usually) shorter list in the Office
button?

You could use
For i = Application.RecentFiles.count to 1 step -1 '(is 1 the right
base - or is it 0?
'delete stuff
Next i

but other entries will move up to become visible in the Office button
list, so you may need to run it more than once.
Without looking further, I don't know how to determine the number of
entries in the registry.

I leave adjusting the code to you - I think I've shown the principle of
why it's going wrong.

The fastest answer might be to cheat!? Use *on error resume next* and
run it 10 times in a loop (cringe).

 

[Mike H]

Geoff,

The error hapens because deleting items 'on the fly' messes up the index so
if you build an array of file indexes to delete the problem goes away. I'm no
authority on the registry but believe that you only need to check for
"[F00000000]") to indicate an unpinned file. It's worked in all my testing
anyway.

Sub ClearMRU_NotPinned()
On Error Resume Next
Dim delfiles()
Max = Application.RecentFiles.Count
ReDim delfiles(1 To Max)
Dim WSHShell, RegKey, rKeyWord
Set WSHShell = CreateObject("WScript.Shell")
RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\File MRU\"
For x = 1 To Application.RecentFiles.Count
rKeyWord = WSHShell.RegRead(RegKey & "Item " &
Application.RecentFiles(x).Index)
If InStr(1, rKeyWord, "[F00000000]") Then
delfiles(x) = Application.RecentFiles(x).Index
End If
Next
For x = UBound(delfiles()) To 1 Step -1
IsPinned = Application.WorksheetFunction.Match(x, delfiles(), 0)
If IsPinned = "" Then
IsPinned = ""
Else
Application.RecentFiles(x).Delete
IsPinned = ""
End If
Next
End Sub
Mike

 

[p45cal]

If I'm right about Application.RecentFiles.Count (this value is the
smaller of the number of entries in the registry and the
Application.RecentFiles.Maximum (this last is the -Number of Recent
files to show-)) being possibly smaller than the number of entries in
the registry, then code so far put forward will only delete those
visible in the Office Button list; others in the registry will move up
and become visible in the Office Button list. So we could temporarily
set the -Number of Recent files to show- to its maximum of 50 and put it
back to its previous setting afterwards:

OriginalMax = Application.RecentFiles.Maximum
Application.RecentFiles.Maximum = 50
'do the main processing here
Application.RecentFiles.Maximum = OriginalMax

Now as long as there are never more than 50 entries in the registry
(can there be?) it should never have to be run more than once.

 

[Mike H]

Hi,

Further testing and I agree your right, well spotted. 50 does seem to be the
max in E2007 so the modified version of my code is below. Thanks for pointing
that out, as I said in my first post with regards to the registry I'm an
absolute novice.

Sub ClearMRU_NotPinned()
On Error Resume Next
OriginalMax = Application.RecentFiles.Maximum
Application.RecentFiles.Maximum = 50
Dim delfiles()
Max = Application.RecentFiles.Count
ReDim delfiles(1 To Max)
Dim WSHShell, RegKey, rKeyWord
Set WSHShell = CreateObject("WScript.Shell")
RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\File MRU\"
For X = 1 To Application.RecentFiles.Count
rKeyWord = WSHShell.RegRead(RegKey & "Item " &
Application.RecentFiles(X).Index)
If InStr(1, rKeyWord, "[F00000000]") Then
delfiles(X) = Application.RecentFiles(X).Index
End If
Next
For X = UBound(delfiles()) To 1 Step -1
IsPinned = Application.WorksheetFunction.Match(X, delfiles(), 0)
If IsPinned = "" Then
IsPinned = ""
Else
Application.RecentFiles(X).Delete
IsPinned = ""
End If
Next
Application.RecentFiles.Maximum = OriginalMax
End Sub


Mike

 

[p45cal]

Mike H,
re:"The error happens because deleting items 'on the fly' messes up the
index so if you build an array of file indices to delete the problem
goes away." and seeing your two loops.

Doesn't the error occur not just because the items are being deleted,
but because they're being deleted AND we're moving down the list, so
that every time we delete something, the items with larger index numbers
(items below the deleted item) get re-indexed?

If we were to run UP the list, deleting 'on-the-fly', any deletions
would only re-index those items that have already been processed. That
way, we wouldn't need to have two loops any more, nor create an array of
items to delete. Something on the lines of:

For X = Application.RecentFiles.Count to 1 step -1
'query and delete item if necessary
Next X


..time passes..

actually I've had a go at coding it, but haven't tested the following:

Sub ClearMRU_NotPinned3()
Dim WSHShell, RegKey, rKeyWord
Set WSHShell = CreateObject("WScript.Shell")
'On Error Resume Next 'I hope this isn't necessary
OriginalMax = Application.RecentFiles.Maximum
Application.RecentFiles.Maximum = 50
RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\File
MRU\"
For X = Application.RecentFiles.Count To 1 Step -1
rKeyWord = WSHShell.RegRead(RegKey & "Item " &
Application.RecentFiles(X).Index)
If InStr(1, rKeyWord, "[F00000000]") Then
Application.RecentFiles(X).Delete
Next X
Application.RecentFiles.Maximum = OriginalMax
End Sub


Geoff,

I'm sure you'll have something that's workable even if it has been
worked to death!

 

[Geoff Budd]

Thanks everybody. I've ended up with the following code, which effectively
just counts backwards, deleting as it goes, and that seems to work.
By the way, the reason I test for [F00000002] is that this indicates a
read-only file that is not pinned - so to catch them all, I have to delete
all those that are prefixed by [F00000000] or [F00000002].
This also works for Word 2007 if you replace "\12.0\Excel\File MRU\" by
"\12.0\Word\File MRU\" in the "RegKey=" statement.
Thanks again - you're all stars!
Geoff

Sub ClearMRU_NotPinned()
Dim X, OriginalMax, NumberOfRecentFiles
Dim RegKey, rKeyWord, WSHShell
OriginalMax = Application.RecentFiles.Maximum
Application.RecentFiles.Maximum = 50
Set WSHShell = CreateObject("WScript.Shell")
RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\File MRU\"
NumberOfRecentFiles = Application.RecentFiles.Count ' (original total file
count)
For X = NumberOfRecentFiles To 1 Step -1
rKeyWord = WSHShell.RegRead(RegKey & "Item " &
Application.RecentFiles(X).Index)
If InStr(1, rKeyWord, "[F00000000]") Then
Application.RecentFiles(X).Delete
End If
If InStr(1, rKeyWord, "[F00000002]") Then
Application.RecentFiles(X).Delete
End If
Next X
Application.RecentFiles.Maximum = OriginalMax
End Sub

Hi,

Further testing and I agree your right, well spotted. 50 does seem to be the
max in E2007 so the modified version of my code is below. Thanks for pointing
that out, as I said in my first post with regards to the registry I'm an
absolute novice.

Sub ClearMRU_NotPinned()
On Error Resume Next
OriginalMax = Application.RecentFiles.Maximum
Application.RecentFiles.Maximum = 50
Dim delfiles()
Max = Application.RecentFiles.Count
ReDim delfiles(1 To Max)
Dim WSHShell, RegKey, rKeyWord
Set WSHShell = CreateObject("WScript.Shell")
RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\File MRU\"
For X = 1 To Application.RecentFiles.Count
rKeyWord = WSHShell.RegRead(RegKey & "Item " &
Application.RecentFiles(X).Index)
If InStr(1, rKeyWord, "[F00000000]") Then
delfiles(X) = Application.RecentFiles(X).Index
End If
Next
For X = UBound(delfiles()) To 1 Step -1
IsPinned = Application.WorksheetFunction.Match(X, delfiles(), 0)
If IsPinned = "" Then
IsPinned = ""
Else
Application.RecentFiles(X).Delete
IsPinned = ""
End If
Next
Application.RecentFiles.Maximum = OriginalMax
End Sub


Mike

If I'm right about Application.RecentFiles.Count (this value is the
smaller of the number of entries in the registry and the
Application.RecentFiles.Maximum (this last is the -Number of Recent
files to show-)) being possibly smaller than the number of entries in
the registry, then code so far put forward will only delete those
visible in the Office Button list; others in the registry will move up
and become visible in the Office Button list. So we could temporarily
set the -Number of Recent files to show- to its maximum of 50 and put it
back to its previous setting afterwards:

OriginalMax = Application.RecentFiles.Maximum
Application.RecentFiles.Maximum = 50
'do the main processing here
Application.RecentFiles.Maximum = OriginalMax

Now as long as there are never more than 50 entries in the registry
(can there be?) it should never have to be run more than once.


--
p45cal

*p45cal*
------------------------------------------------------------------------
p45cal's Profile: http://www.thecodecage.com/forumz/member.php?userid=558
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=147510

.

 

[p45cal]

Geoff,
if that works - great.
Being picky-picky, the only thing I'd like to see changed here is this
bit:

If InStr(1, rKeyWord, "[F00000000]") Then
Application.RecentFiles(X).Delete
End If
If InStr(1, rKeyWord, "[F00000002]") Then
Application.RecentFiles(X).Delete
End If

In the unlikely event of both those IFs being true (I know, I know -
very unlikely), then both IFs would try to delete a file - but they'd be
_different__files..

How about combining the above 6 lines into one IF (There's no need for
*End If*s if there's only one action to undertake):

If InStr(rKeyWord, "[F00000000]") or InStr(rKeyWord, "[F00000002]")
Then Application.RecentFiles(X).Delete
(and I've taken out the *1*s from the -Instr- functions -
not needed)

BTW, where did you post before - where the thread 'dried up'?

 

[Mike H]

Yes I agree it's precisely the same as deleting rows on a worksheet, do it
forwards on the fly and you'll potentially miss rows, do it backwards and you
won't.

I ended up with 2 loops because of my confessed lack of understanding of the
registry. I had no idea that it held a record of items not displayed in the
recent files list. I imagined that when you set Excel to display n items then
the registry only held n records with records higher than n being deleted
from the registry.

With the benefit of this new found knowledge I would do it in a single
reverse loop. I didn't bother re-writing the code to do this because as the
OP hasn't responded to the post in > 9hrs I guessed interest in it had been
lost.

Mike

 

[Geoff Budd]

Hi p45cal
I don't think both Ifs can be true as the first 11 characters of each
registry entry will contain either [F00000000], [F00000001], [F00000002] or
[F00000003]. They can't contain more than one of these strings
simultaneously.
However, your one-line code seems very neat!
Looking at my original code again, it's surprising that the If statements
actually work at all, as the InStr function will return either 1 (if it finds
the string, which will start in position 1) or 0 (if it doesn't find it). As
the If statement is looking for either True (-1) or False (0), it seems
interesting that it executes the delete even though the InStr returns 1.
Perhaps the If statement only checks for False (0)? I think to be absolutely
safe, maybe the If statement should read:
If (InStr(1, rKeyWord, "[F00000000]")=1) Then ...

My original post that dried up was was in the Excel Programming group here
and was entitled:
Macro to delete Recent Files list (except those "pinned") - Excel.
It was dated 10/20/2009

Regards,
Geoff

 

[Rick Rothstein]

If InStr(rKeyWord, "[F00000000]") or InStr(rKeyWord, "[F00000002]")

Then Application.RecentFiles(X).Delete

You can "simplify" the above line by using the Like operator instead of the
InStr function...

If rKeyWord Like "[[]F0000000[02]]" Then Application.RecentFiles(X).Delete

--
Rick (MVP - Excel)

Geoff,
if that works - great.
Being picky-picky, the only thing I'd like to see changed here is this
bit:

If InStr(1, rKeyWord, "[F00000000]") Then
Application.RecentFiles(X).Delete
End If
If InStr(1, rKeyWord, "[F00000002]") Then
Application.RecentFiles(X).Delete
End If

In the unlikely event of both those IFs being true (I know, I know -
very unlikely), then both IFs would try to delete a file - but they'd be
_different__files..

How about combining the above 6 lines into one IF (There's no need for
*End If*s if there's only one action to undertake):

If InStr(rKeyWord, "[F00000000]") or InStr(rKeyWord, "[F00000002]")
Then Application.RecentFiles(X).Delete
(and I've taken out the *1*s from the -Instr- functions -
not needed)

BTW, where did you post before - where the thread 'dried up'?

 

[Geoff Budd]

Thanks Rick. I think we'd better close this thread now as we've solved the
basic problem and we could go on forever making the code more elegant.
Thanks to everyone for all the helpful suggestions.
Best wishes,
Geoff

If InStr(rKeyWord, "[F00000000]") or InStr(rKeyWord, "[F00000002]")
Then Application.RecentFiles(X).Delete

You can "simplify" the above line by using the Like operator instead of the
InStr function...

If rKeyWord Like "[[]F0000000[02]]" Then Application.RecentFiles(X).Delete

--
Rick (MVP - Excel)

Geoff,
if that works - great.
Being picky-picky, the only thing I'd like to see changed here is this
bit:

If InStr(1, rKeyWord, "[F00000000]") Then
Application.RecentFiles(X).Delete
End If
If InStr(1, rKeyWord, "[F00000002]") Then
Application.RecentFiles(X).Delete
End If

In the unlikely event of both those IFs being true (I know, I know -
very unlikely), then both IFs would try to delete a file - but they'd be
_different__files..

How about combining the above 6 lines into one IF (There's no need for
*End If*s if there's only one action to undertake):

If InStr(rKeyWord, "[F00000000]") or InStr(rKeyWord, "[F00000002]")
Then Application.RecentFiles(X).Delete
(and I've taken out the *1*s from the -Instr- functions -
not needed)

BTW, where did you post before - where the thread 'dried up'?

.

 

[Rick Rothstein]

The purpose of my posting that code snippet was not to show that I can write
"elegant" code; rather, it is my way of introducing readers of the thread to
what I think is a very powerful VB construct... the Like operator. My hope
is that seeing it in action will spur those interested readers into checking
it out in the help files and then put it to use in their own coding.

--
Rick (MVP - Excel)

Thanks Rick. I think we'd better close this thread now as we've solved
the
basic problem and we could go on forever making the code more elegant.
Thanks to everyone for all the helpful suggestions.
Best wishes,
Geoff

If InStr(rKeyWord, "[F00000000]") or InStr(rKeyWord, "[F00000002]")
Then Application.RecentFiles(X).Delete

You can "simplify" the above line by using the Like operator instead of
the
InStr function...

If rKeyWord Like "[[]F0000000[02]]" Then
Application.RecentFiles(X).Delete

--
Rick (MVP - Excel)

Geoff,
if that works - great.
Being picky-picky, the only thing I'd like to see changed here is this
bit:

If InStr(1, rKeyWord, "[F00000000]") Then
Application.RecentFiles(X).Delete
End If
If InStr(1, rKeyWord, "[F00000002]") Then
Application.RecentFiles(X).Delete
End If

In the unlikely event of both those IFs being true (I know, I know -
very unlikely), then both IFs would try to delete a file - but they'd
be
_different__files..

How about combining the above 6 lines into one IF (There's no need for
*End If*s if there's only one action to undertake):

If InStr(rKeyWord, "[F00000000]") or InStr(rKeyWord, "[F00000002]")
Then Application.RecentFiles(X).Delete
(and I've taken out the *1*s from the -Instr- functions -
not needed)

BTW, where did you post before - where the thread 'dried up'?


--
p45cal

*p45cal*
------------------------------------------------------------------------
p45cal's Profile:
http://www.thecodecage.com/forumz/member.php?userid=558
View this thread:
http://www.thecodecage.com/forumz/showthread.php?t=147510

.