Macro to delete registry MRU items.

[mgfacioli]

Hello, Friends ...

I'm trying to create an Excel macro to delete from the list of recent documents only those not pinned, directly from registry (HKLM \ Software \ Microsoft \ Office \ 12.0 \ Excel \ File MRU), since I have not found another way to do it . I got some parts of the code on the internet and, after some changes, it looked like this:

Sub Clear_ExcelMRU()
Const HKEY_CURRENT_USER = &H80000001
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
MRU_PINNED = "F00000001"
MRU_UNPINNED = "F00000000"
strComputer = "."

Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

strKeyPath = "Software\Microsoft\Office\12.0\Excel\File MRU"
objRegistry.EnumValues HKEY_CURRENT_USER, strKeyPath, arrValueNames, arrValueTypes

For I = 0 To UBound(arrValueNames)
strText = arrValueNames(I)
strValueName = arrValueNames(I)
strValReg = ""
Select Case arrValueTypes(I)
Case REG_SZ
objRegistry.GetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strvalue
If Mid(strvalue, 2, 9) = MRU_PINNED Then
strText = strText & ": " & strvalue & Chr(13) & "MRU_PINNED"
ElseIf Mid(strvalue, 2, 9) = MRU_UNPINNED Then
strText = strText & ": " & strvalue & Chr(13) & "MRU_UNPINNED"
strValReg = "HKEY_CURRENT_USER\" & strKeyPath & "\" & strValueName
Kill strValReg
End If
Case REG_DWORD
objRegistry.GetDWORDValue HKEY_CURRENT_USER, strKeyPath, strValueName, intValue
strText = strText & ": " & intValue
Case REG_MULTI_SZ
objRegistry.GetMultiStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, arrValues
strText = strText & ": "
For Each strvalue In arrValues
strText = strText & " " & strvalue
Next
Case REG_EXPAND_SZ
objRegistry.GetExpandedStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strvalue
strText = strText & ": " & strvalue
Case REG_BINARY
objRegistry.GetBinaryValue HKEY_CURRENT_USER, strKeyPath, strValueName, arrValues
strText = strText & ": "
For Each strvalue In arrValues
strText = strText & " " & strvalue
Next
End Select
MsgBox strText
Next
End Sub

But I am not able to delete the not pinned itens from registry by using the "Kill" statement in the first option of select case (Case REG_SZ).

What's wrong? Is there another way to do it?
Thanks.

 

[mgfacioli]

Hello, my friends...

After some Internet research, I got a good solution for my previous question, and I want to share it with you because I think it can be very useful.

Problem: My Office button in Excel is configured to show the latest 30 files in the list of recent files (MRU - Most Recent Used). Some of these files are pinned because I use them very often during the workday. The other files (most of all) I use occasionally, thus, remain unpinned. They are many and end up polluting the MRU list.

I wanted a way to clean up the unpinned files from de MRU list but I wanted to keep in a worksheet what were those files (name, path, etc).

Some of our friends had suggested changing the number of files that appear in the MRU list, but this clears both pinned and unpinned files. Others suggested I use the property "RecentFiles" of the Application object in an Excel Macro, but this way I could not just delete the files that were unpinned. Neither did exactly what I wanted.

So finally I got what I wanted and the result is the macro below. Basically, and in few words, this macro accesses the registry key from Excel MRU, checks to see which keys are registered as unpinned ("F00000000" key state), copy their names and paths to "UnpinnedWorksheet.xls" workbook, "ClearedMRU" worksheets, deletes the MRU Key and save de workbook. However, this change takes effect only after you restart Excel. After, you can check that only the pinned files remain on the list of recent files.

I apologize for not having done a better refinement of the Macro, but I wanted to show it to you. If anyone has suggestions, please share with us.

Cordially.

'=================================================================
'   API Calls
'=================================================================
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
'=================================================================
 
Sub Clear_ExcelMRU()
'---------------------------------------------------------------------------------------
' Procedure : Clear_ExcelMRU
'---------------------------------------------------------------------------------------
'
'=================================================================
'  PROCEDURE LEVEL CONSTANTS
'=================================================================
Const HKEY_CURRENT_USER = &H80000001
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const MRU_PINNED = "F00000001"
Const MRU_UNPINNED = "F00000000"
Const strComputer = "."
Const strKeyPath = "Software\Microsoft\Office\12.0\Excel\File MRU"  'Registry Path from MRU
'=================================================================
'=================================================================
'   PROCEDURE LEVEL VARIABLES
'=================================================================
Dim wkbMRU As Workbook
Dim wksClearedMRU As Worksheet
Dim strValueName As String
Dim strFullWksPath As String, strFileName As String
Dim iFimLin As Integer, iCtLine As Integer
'=================================================================
Set wkbMRU = Workbooks("UnpinnedWorksheet.xls")
Set wksClearedMRU = wkbMRU.Worksheets("ClearedMRU")
wksClearedMRU.Select
iFimLin = wksClearedMRU.cells(65536,1).end(xlup).row + 1
iCtLine = iFimLin
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
objRegistry.EnumValues HKEY_CURRENT_USER, strKeyPath, arrValueNames, arrValueTypes
 
 For I = 0 To UBound(arrValueNames)
   strText = arrValueNames(I)
   strValueName = arrValueNames(I)
   Select Case arrValueTypes(I)
     Case REG_SZ
       objRegistry.GetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strValue
             If Mid(strValue, 2, 9) = MRU_PINNED Then
             ElseIf Mid(strValue, 2, 9) = MRU_UNPINNED Then
               strFullWksPath = Mid(strValue, (InStr(1, strValue, "*")) + 1)
               strFileName = Mid(strFullWksPath, InStrRev(strFullWksPath, "\") + 1)
               wksClearedMRU.Cells(iCtLine, 1).Select
               With wksClearedMRU.Cells(iCtLine, 1)
                 .Value = strFileName
                 .Font.Bold = True
               End With
               wksClearedMRU.Cells(iCtLine, 2).Value = strFullWksPath
               wksClearedMRU.Cells(iCtLine, 3).Value = Now()
               iCtLine = iCtLine + 1
               DeleteSetting HKEY_CURRENT_USER, strKeyPath, strValueName
             End If
     Case REG_DWORD
       objRegistry.GetDWORDValue HKEY_CURRENT_USER, strKeyPath, strValueName, intValue
       strText = strText & ": " & intValue
     Case REG_MULTI_SZ
       objRegistry.GetMultiStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, arrValues
       strText = strText & ": "
       For Each strValue In arrValues
         strText = strText & "   " & strValue
       Next
     Case REG_EXPAND_SZ
       objRegistry.GetExpandedStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strValue
       strText = strText & ": " & strValue
     Case REG_BINARY
       objRegistry.GetBinaryValue HKEY_CURRENT_USER, strKeyPath, strValueName, arrValues
       strText = strText & ": "
       For Each strValue In arrValues
         strText = strText & " " & strValue
       Next
     End Select
 Next
wkbMRU.Save
End Sub
Sub DeleteSetting(hKey As Long, strPath As String, strValue As String)
'---------------------------------------------------------------------------------------
' Procedure : DeleteSetting
'---------------------------------------------------------------------------------------
'
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strPath, Ret
    'Delete the key's value
    RegDeleteValue Ret, strValue
    'close the key
    RegCloseKey Ret
End Sub