Script to check Start Menu links

[mweller]

Hi

 

I am looking to create a script that checks a users start menu for dead links and if this doesn't exist to apply the hidden attribute, or if that is not possible delete it. The start menu has been redirected to a specific location within a users profile and is copied from a central share on a server and this works well but with an ever growing list of software more and more dead links are being added to users start menus.

 

I don't have much experience with scripting so wondered if anyone could help me?

 

Thanks

Mark

[peterp]

The following program I wrote as a login script.

It will copy a start menu from the server (Containing links to all programs) and create a start menu for the user containing only those links to which they have access

 

I believe the function you want is covered by this. It will ensure that the link is resolvable, before copying to the user profile.

The part you are interested in is the 'CheckValidShortcut' function. I include the rest in case it's of interest to others.

 

The code also enables you to assign security groups to the shortcuts, so they only copy if they user has access, even if the program is installed'

 

 

 

'Copy Server start menu to local if available

'Share where server copy of start menu is held
strServerStartMenu = "\\Servername\Shortcuts$"
Set oFSO = CreateObject("Scripting.FileSystemObject") 
Set oShell = CreateObject("Wscript.Shell") 
strUserProfile = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
strLocalStartMenu = strUserProfile + "\AppData\Roaming\Microsoft\Windows\Start Menu\Programs"
if oFSO.folderexists (strServerStartMenu) then
if oFSO.folderexists(strLocalStartMenu) Then
	On Error Resume Next
	set delfolder= oFSO.GetFolder(strLocalStartMenu)
	delfolder.delete
end if
oFSO.createfolder(strLocalStartMenu)
Call CopyFolderRecursively(strServerStartMenu, strLocalStartMenu)
Call RemoveEmptyFolders(strLocalStartMenu)
end if

Sub RemoveEmptyFolders(strPath)
On Error Resume Next
err.clear
Set objCurrentFolder = oFSO.GetFolder(strPath)
For Each objFolder in ObjCurrentFolder.SubFolders
	if not FolderEmpty(objFolder) then
		RemoveEmptyFolders(strPath & "\" & objFolder.Name)
	else
		objFolder.delete
	end if
next
End Sub

Sub CopyFolderRecursively(strSrcPath, strDestPath) 
On Error Resume Next
       Set objCurrentFolder = oFSO.GetFolder(strSrcPath) 
 
       For Each objFile In objCurrentFolder.Files 
               ' Create new folder if it's not there 
           If Not oFSO.FolderExists(strDestPath) Then 			
			oFSO.CreateFolder(strDestPath) 
		end if
           strDestFile = strDestPath & "\" & objFile.Name
		if CheckValidShortcut(objFile) Then 
			oFSO.CopyFile objFile, strDestFile
		end if 
		err.clear
       Next 
 
 	For Each objFolder In objCurrentFolder.subFolders 
               Call CopyFolderRecursively(objFolder, strDestPath & "\" & objFolder.Name) 
       Next 
End Sub 

Function CheckValidShortcut(objCheckFile)
If LCase(oFSO.GetExtensionName(objCheckFile.name)) = "lnk" Then
	Set oLnk = oShell.CreateShortcut(objCheckFile.path)
		If oFSO.FileExists(oLnk.TargetPath) Then
			CheckValidShortcut = true
		Else
			CheckValidShortcut = False
		End If
End If
End Function

Function FolderEmpty(strFolderPathName)
Dim oFiles, oFile, oFolder, oSubFolders, oSubFolder
Set oFolder = oFSO.GetFolder(strFolderPathName)
Set oFiles = oFolder.Files
Set oSubFolders = oFolder.SubFolders
if oSubFolders.Count > 0 then
	FolderEmpty = False
	exit Function
end if
If oFiles.Count > 0 Then
	FolderEmpty = False
	Exit Function
End If
FolderEmpty = True
End Function

[deano]

How do find the logon times during the processing of your script?

[mweller]

Thanks PeterP, just what I was looking for. With regards to logon times if I included the whole script added approx. 2-3 seconds on a brand new machine, and 10 seconds on our oldest machines. HTH

[deano]

Thanks to PeterP for the script. Did you have any issues with x64/x86 shortcuts and (seperately) subfolders?

[mweller]

No, its seemed to of worked well so far.

[peterp]

The script will handle subfolders, it will even remove the folder from the users start menu if there are no valid shortcuts in it.

If a shortcut cannot be resolved (either because its target doesn't exist, or the user has no permissions to that program) then it is not put into the start menu.

If the shortcut can be resolved, then it will be put into the start menu, regardless of its location.