Option Explicit
Option Private Module
‘A reference to the Registration Manipulation Classes must be set.
Dim m_regRootKey As RegKey
Dim m_regMainKey As RegKey
Dim m_stSubRoot As String
Dim m_stSubPlace As String
Sub Add_ShortCut_Office()
If Add_ShortCut(“11.0”, “XL-Dennis”, “My storage”, “c:XL-Dennis”, 0) Then
MsgBox “The shortcut has successfully been added to the list.”, vbInformation
Else
MsgBox “The shortcut already exist in Windows Registry.”, vbInformation
End If
End Sub
Sub Remove_ShortCut_Office()
If Remove_ShortCut(“11.0”, “XL-Dennis”, 1) Then
MsgBox “The shortcut has successfully been removed.”, vbInformation
Else
MsgBox “The shortcut does not exist in Windows Registry.”, vbInformation
End If
End Sub
Function Add_ShortCut(ByVal stXLVersion, _
ByVal stMainKey As String, _
ByVal stName As String, _
ByVal stPath As String, _
ByVal lnSize As Long) As Boolean
On Error GoTo Error_Handling
‘Registry path to set the size of the shortcuts in the dialogs.
m_stSubPlace = “SoftwareMicrosoftOffice” & stXLVersion & _
“CommonOpen FindPlaces”
‘Registry path to add user defined places.
m_stSubRoot = “SoftwareMicrosoftOffice” & stXLVersion & _
“CommonOpen FindPlacesUserDefinedPlaces”
‘Set the rootkey.
Set m_regRootKey = RegKeyFromHKey(HKEY_CURRENT_USER)
‘Parse the subkey.
Set m_regMainKey = m_regRootKey.ParseKeyName(m_stSubRoot)
With m_regMainKey
.SubKeys.Add stMainKey ‘Create the subkey.
With .SubKeys(stMainKey)
‘Add the shortcuts which are string values.
.Values.Add “Name”, stName, RegValueType.rvString
.Values.Add “Path”, stPath, RegValueType.rvString
End With
End With
‘Parse the subkey.
Set m_regMainKey = m_regRootKey.ParseKeyName(m_stSubPlace)
‘It seems that there only exist two workable values, 0 and 1
‘where 0 represent the compacted status and 1 the standard.
If lnSize > 1 Then
lnSize = 1
ElseIf lnSize < 0 Then
lnSize = 0
End If
If m_regMainKey.Values(“ItemSize”).Value <> lnSize Then
m_regMainKey.Values(“ItemSize”).Value = lnSize
End If
Add_ShortCut = True
ExitHere:
‘Release objects from memory.
Set m_regRootKey = Nothing
Set m_regMainKey = Nothing
Exit Function
Error_Handling:
‘Error 35004 indicates that the shortcut entry already exist.
If Err.Number = 35004 Then Add_ShortCut = False
Resume ExitHere
End Function
Function Remove_ShortCut(ByVal stXLVersion, _
ByVal stMainKey As String, _
ByVal lnSize As Long) As Boolean
On Error GoTo Error_Handling
m_stSubPlace = “SoftwareMicrosoftOffice” & stXLVersion & _
“CommonOpen FindPlaces”
m_stSubRoot = “SoftwareMicrosoftOffice” & stXLVersion & _
“CommonOpen FindPlacesUserDefinedPlaces”
Set m_regRootKey = RegKeyFromHKey(HKEY_CURRENT_USER)
Set m_regMainKey = m_regRootKey.ParseKeyName(m_stSubRoot)
m_regMainKey.SubKeys.Remove stMainKey
Set m_regMainKey = m_regRootKey.ParseKeyName(m_stSubPlace)
If lnSize > 1 Then
lnSize = 1
ElseIf lnSize < 0 Then
lnSize = 0
End If
If m_regMainKey.Values(“ItemSize”).Value <> lnSize Then
m_regMainKey.Values(“ItemSize”).Value = lnSize
End If
Remove_ShortCut = True
ExitHere:
Set m_regRootKey = Nothing
Set m_regMainKey = Nothing
Exit Function
Error_Handling:
‘Error 35006 indicates that the shortcut entry does not exist.
If Err.Number = 35006 Then Remove_ShortCut = False
Resume ExitHere
End Function
