[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

VB script that lists shortcuts and if target exits

Posted on 2011-10-24
2
Medium Priority
?
216 Views
Last Modified: 2013-12-28
I have found a script in this thread that almost does what I want (Thank you very much sirbounty!):
http://www.experts-exchange.com/OS/Microsoft_Operating_Systems/Windows/98/Q_22497445.html?sfQueryTermInfo=1+10+30+list+shortcut+target#a18870523

 It lists all the shortcuts in a directory with the targets and put it in a txt file. I have modified it a little to use “;” instead of “,” to separate the columns. I would like to add one thing more to the script though.
I would like to add a column that says “yes” if the file/directory in the target still exists and “no” if it does not. Here is the script:
'' /// Setup environment declarations and object references ///
Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objShell:Set objShell = CreateObject("Wscript.Shell")
Dim objFolder:Set objFolder = objFSO.GetFolder("C:\Install\Senast")
Dim objOutput:Set objOutput = objFSO.CreateTextFile("C:\Shortcuts.txt")

' /// Run the main routine, ProcessFolder, a recursive search through the files/folders found in the objFolder reference ///
  ProcessFolder (objFolder)

' /// Close file and destroy object references, finalizing the script ///
objOutput.Close
Set objOutput=Nothing
Set objFolder=Nothing
Set objShell=Nothing
Set objFSO=Nothing
wscript.quit

' /// Main routine to scan current folder and recursively call against sub folders ///
Sub ProcessFolder(fld)
  Set subFld = objFSO.GetFolder(fld) ' Set object reference against current folder
  ProcessFile (subFld) 'Call Processfile routine against current folder
  For Each fld In subFld.SubFolders 'loop through all subfolders, recalling the same routine
    ProcessFolder (fld)
  Next
End Sub

' /// Routine to process all container files within the passed folder reference
Sub ProcessFile(fld)
  Set objFld = objFSO.GetFolder(fld) 'create object reference to the current folder
  For Each file In objFld.Files 'loop through all files found
  If objFSO.GetExtensionName(file) = "lnk" Then 'if the extension is 'lnk', it's a shortcut - only proceed if this returns TRUE
    Set objFile = objShell.CreateShortcut(file) 'create a shell reference to the file
    objOutput.WriteLine file & ";" & objFile.TargetPath  'Write the file path and target path values to the output file
    Set objFile = Nothing 'destory object reference
  End If
Next
End Sub
0
Comment
Question by:-andreas-
2 Comments
 
LVL 65

Accepted Solution

by:
RobSampson earned 2000 total points
ID: 37021158
Hi, that should be easy enough.  I have change this:
    objOutput.WriteLine file & ";" & objFile.TargetPath  'Write the file path and target path values to the output file

to this:
    strTargetPath = objFile.TargetPath
    strExists = "No"
    If objFSO.FolderExists(strTargetPath) = True Then strExists = "Yes"
    If objFSO.FileExists(strTargetPath) = True Then strExists = "Yes"
    objOutput.WriteLine file & ";" & objFile.TargetPath & ";" & strExists 'Write the file path and target path values to the output file

Regards,

Rob.
Dim objFSO:Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objShell:Set objShell = CreateObject("Wscript.Shell")
Dim objFolder:Set objFolder = objFSO.GetFolder("C:\Install\Senast")
Dim objOutput:Set objOutput = objFSO.CreateTextFile("C:\Shortcuts.txt")

' /// Run the main routine, ProcessFolder, a recursive search through the files/folders found in the objFolder reference ///
  ProcessFolder (objFolder)

' /// Close file and destroy object references, finalizing the script ///
objOutput.Close
Set objOutput=Nothing
Set objFolder=Nothing
Set objShell=Nothing
Set objFSO=Nothing
wscript.quit

' /// Main routine to scan current folder and recursively call against sub folders ///
Sub ProcessFolder(fld)
  Set subFld = objFSO.GetFolder(fld) ' Set object reference against current folder
  ProcessFile (subFld) 'Call Processfile routine against current folder
  For Each fld In subFld.SubFolders 'loop through all subfolders, recalling the same routine
    ProcessFolder (fld) 
  Next
End Sub

' /// Routine to process all container files within the passed folder reference
Sub ProcessFile(fld)
  Set objFld = objFSO.GetFolder(fld) 'create object reference to the current folder
  For Each file In objFld.Files 'loop through all files found
  If objFSO.GetExtensionName(file) = "lnk" Then 'if the extension is 'lnk', it's a shortcut - only proceed if this returns TRUE
    Set objFile = objShell.CreateShortcut(file) 'create a shell reference to the file
    strTargetPath = objFile.TargetPath
    strExists = "No"
    If objFSO.FolderExists(strTargetPath) = True Then strExists = "Yes"
    If objFSO.FileExists(strTargetPath) = True Then strExists = "Yes"
    objOutput.WriteLine file & ";" & objFile.TargetPath & ";" & strExists 'Write the file path and target path values to the output file
    Set objFile = Nothing 'destory object reference
  End If
Next
End Sub

Open in new window

0
 

Author Closing Comment

by:-andreas-
ID: 37026160
Thank you very much! It worked.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When asking a question in a forum or creating documentation, screenshots are vital tools that can convey a lot more information and save you and your reader a lot of time
This article is about my experience upgrading my consulting machine to Windows 10 Version 1709 (The Fall 2017 Creator Update)
In this video, we discuss why the need for additional vertical screen space has become more important in recent years, namely, due to the transition in the marketplace of 4x3 computer screens to 16x9 and 16x10 screens (so-called widescreen format). …
With the advent of Windows 10, Microsoft is pushing a Get Windows 10 icon into the notification area (system tray) of qualifying computers. There are many reasons for wanting to remove this icon. This two-part Experts Exchange video Micro Tutorial s…

872 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question