• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 474
  • Last Modified:

VbScript to Query Users Desktops of a Certain Shortcut to a Folder or Share

Dear experts,

I have a task to query multiple machines of a shortcut or folder on user's desktop that contains of the word "ABE Materials" . Can someone please help me tweak my script?

Hello experts,

I have a list of workstations that I need to query to find out which ones have a folder that contains the word "ABC" on their desktop folder shortcuts (rather than a static variable use a wildcard) Example is to query ABC Folder or Folder ABC. Can someone please help me tweak the script below?

Const ForReading = 1
Const ForWriting = 2

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("C:\DesktopsFinal.txt", ForReading)
Set objResultFile = objFSO.OpenTextFile("C:\CheckFolderResults.txt", ForWriting, True)

arrTextFile = Split(objTextFile.ReadAll, vbCrLf)
objTextFile.Close

For i = 0 To UBound(arrTextFile)
  strComputer = "\\" & arrTextFile(i)
  If objFSO.FolderExists(strComputer & "\C$\ABC") Then  
    objResultFile.WriteLine "Folder found on " & strComputer
  Else
    objResultFile.WriteLine "Folder not found on " & strComputer
  End If
Next

objResultFile.Close
WScript.Echo "All Done!"
 
0
mmoya
Asked:
mmoya
  • 9
  • 6
  • 2
1 Solution
 
Bill PrewCommented:
First question is what version of Windows will be running on the computers to be checked?

Second question, what users Desktop do you want to look for the file on each computer.

You won't be able to use FolderExists, it doesn't support wildcards, so you will either have to check all folders on the Desktop and see if their name contains ABC, or you can use WMI so search for folders using "*ABC*" on the Desktop.

~bp
0
 
RobSampsonCommented:
Hi, you could see if this works for you.  It will check each users Desktop for folders, files, or shortcuts with a target path with strNameToFind in it.

Regards,

Rob.
Const ForReading = 1
Const ForWriting = 2

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("C:\DesktopsFinal.txt", ForReading)
Set objResultFile = objFSO.OpenTextFile("C:\CheckFolderResults.txt", ForWriting, True)

arrTextFile = Split(objTextFile.ReadAll, vbCrLf)
objTextFile.Close

strNameToFind = "ABC"

For i = 0 To UBound(arrTextFile)
	strComputer = arrTextFile(i)
	If Ping(strComputer) = True Then
		strRootFolder = "\\" & strComputer & "\C$\Documents and Settings\"
		If objFSO.FolderExists(strRootFolder) = True Then
			For Each objUserFolder In objFSO.GetFolder(strRootFolder).SubFolders
				If LCase(objUserFolder.Name) <> "local service" And LCase(objUserFolder.Name) <> "network service" And LCase(objUserFolder.Name) <> "all users" And LCase(objUserFolder.Name) <> "default user" Then
					strDesktop = strRootFolder & objUserFolder.Name & "\Desktop\"
					For Each objFolder In objFSO.GetFolder(strDesktop).SubFolders
						If InStr(LCase(objFolder.Name), LCase(strNameToFind)) > 0 Then  
							objResultFile.WriteLine "Folder found on " & strComputer & ": " & objFolder.Path
						End If
					Next
					For Each objFile In objFSO.GetFolder(strDesktop).Files
						If InStr(LCase(objFile.Name), LCase(strNameToFind)) > 0 Then  
							objResultFile.WriteLine "File found on " & strComputer & ": " & objFile.Path
						End If
						If InStr(objFile.Name, ".") > 0 Then
							If LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = ".lnk" Then
								Set objShortcut = objShell.CreateShortcut(objFile.Path)
								If InStr(LCase(objShortcut.TargetPath), LCase(strNameToFind)) > 0 Then
									objResultFile.WriteLine "Shortcut found on " & strComputer & " in " & objFile.Path & ": " & objShortcut.TargetPath
								End If
							End If
						End If
					Next					
				End If
			Next
		Else
			objResultFile.WriteLine "Could not find " & strRootFolder & " on " & strComputer
		End If
	Else
		objResultFile.WriteLine strComputer & " is offline"
	End If
Next

objResultFile.Close
WScript.Echo "All Done!"

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 
mmoyaAuthor Commented:
@ billprew - it's a combination of Windows XP and Windows 7.

@ Rob Sampson - thank you for the info - really appreciate it. Although I ran the script and I received a "script runtime error: permission denied" error. Please advise. Thank you again.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
mmoyaAuthor Commented:
@ Rob Sampson - I tried running this script from a server rather than my regular desktop with full admin rights and I'm getting a syntax error...
0
 
mmoyaAuthor Commented:
@ Rob Sampson - Sorry forgot to include where is erroring out it is --> (20, 108)
0
 
mmoyaAuthor Commented:
@ Rob Sampson - and the permission denied error is erroring out from lines ->
(19, 4)
0
 
RobSampsonCommented:
Hi, you will need full admin rights on your target machines because it utilises the admin share.

Try this.

Regards,

Rob.
Const ForReading = 1
Const ForWriting = 2

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("C:\DesktopsFinal.txt", ForReading)
Set objResultFile = objFSO.OpenTextFile("C:\CheckFolderResults.txt", ForWriting, True)

arrTextFile = Split(objTextFile.ReadAll, vbCrLf)
objTextFile.Close

strNameToFind = "ABC"

For i = 0 To UBound(arrTextFile)
	strComputer = arrTextFile(i)
	If Ping(strComputer) = True Then
		strRootFolder = "\\" & strComputer & "\C$\Documents and Settings\"
		If objFSO.FolderExists(strRootFolder) = True Then
			For Each objUserFolder In objFSO.GetFolder(strRootFolder).SubFolders
				If LCase(objUserFolder.Name) <> "localservice" And LCase(objUserFolder.Name) <> "networkservice" And LCase(objUserFolder.Name) <> "all users" And LCase(objUserFolder.Name) <> "default user" Then
					strDesktop = strRootFolder & objUserFolder.Name & "\Desktop\"
					If objFSO.FolderExists(strDesktop) = True Then
						For Each objFolder In objFSO.GetFolder(strDesktop).SubFolders
							If InStr(LCase(objFolder.Name), LCase(strNameToFind)) > 0 Then  
								objResultFile.WriteLine "Folder found on " & strComputer & ": " & objFolder.Path
							End If
						Next
						For Each objFile In objFSO.GetFolder(strDesktop).Files
							If InStr(LCase(objFile.Name), LCase(strNameToFind)) > 0 Then  
								objResultFile.WriteLine "File found on " & strComputer & ": " & objFile.Path
							End If
							If InStr(objFile.Name, ".") > 0 Then
								If LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = ".lnk" Then
									Set objShortcut = objShell.CreateShortcut(objFile.Path)
									If InStr(LCase(objShortcut.TargetPath), LCase(strNameToFind)) > 0 Then
										objResultFile.WriteLine "Shortcut found on " & strComputer & " in " & objFile.Path & ": " & objShortcut.TargetPath
									End If
								End If
							End If
						Next
					Else
						objResultFile.WriteLine "Could not find desktop folder at " & strDesktop
					End If
				End If
			Next
		Else
			objResultFile.WriteLine "Could not find " & strRootFolder & " on " & strComputer
		End If
	Else
		objResultFile.WriteLine strComputer & " is offline"
	End If
Next

objResultFile.Close
WScript.Echo "All Done!"

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 
Bill PrewCommented:
Rob, won't logic be needed to differentiate between XP and Windows 7 (Users folder versus Documents and Settings)?

~bp
0
 
RobSampsonCommented:
Yes, definately, I missed the OS comment....

We can just try testing for C:\Users or C:\Documents and Settings

Rob.
Const ForReading = 1
Const ForWriting = 2

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("C:\DesktopsFinal.txt", ForReading)
Set objResultFile = objFSO.OpenTextFile("C:\CheckFolderResults.txt", ForWriting, True)

arrTextFile = Split(objTextFile.ReadAll, vbCrLf)
objTextFile.Close

strNameToFind = "ABC"

arrRootPaths = Array("C:\Users\", "C:\Documents and Settings\")
For i = 0 To UBound(arrTextFile)
	strComputer = arrTextFile(i)
	If Ping(strComputer) = True Then
		For Each strRootPath In arrRootPaths
			strRootFolder = "\\" & strComputer & "\" & Replace(strRootPath, ":", "$")
			If objFSO.FolderExists(strRootFolder) = True Then
				For Each objUserFolder In objFSO.GetFolder(strRootFolder).SubFolders
					If LCase(objUserFolder.Name) <> "localservice" And LCase(objUserFolder.Name) <> "networkservice" And LCase(objUserFolder.Name) <> "all users" And LCase(objUserFolder.Name) <> "default user" Then
						strDesktop = strRootFolder & objUserFolder.Name & "\Desktop\"
						If objFSO.FolderExists(strDesktop) = True Then
							For Each objFolder In objFSO.GetFolder(strDesktop).SubFolders
								If InStr(LCase(objFolder.Name), LCase(strNameToFind)) > 0 Then  
									objResultFile.WriteLine "Folder found on " & strComputer & ": " & objFolder.Path
								End If
							Next
							For Each objFile In objFSO.GetFolder(strDesktop).Files
								If InStr(LCase(objFile.Name), LCase(strNameToFind)) > 0 Then  
									objResultFile.WriteLine "File found on " & strComputer & ": " & objFile.Path
								End If
								If InStr(objFile.Name, ".") > 0 Then
									If LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = ".lnk" Then
										Set objShortcut = objShell.CreateShortcut(objFile.Path)
										If InStr(LCase(objShortcut.TargetPath), LCase(strNameToFind)) > 0 Then
											objResultFile.WriteLine "Shortcut found on " & strComputer & " in " & objFile.Path & ": " & objShortcut.TargetPath
										End If
									End If
								End If
							Next
						Else
							objResultFile.WriteLine "Could not find desktop folder at " & strDesktop
						End If
					End If
				Next
			Else
				objResultFile.WriteLine "Could not find " & strRootFolder & " on " & strComputer
			End If
		Next
	Else
		objResultFile.WriteLine strComputer & " is offline"
	End If
Next

objResultFile.Close
WScript.Echo "All Done!"

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 
mmoyaAuthor Commented:
Thank you guys.. Question - I need to query Folders and Shortcuts. I noticed the script works but for Folders only. How can be a shortcut included in the query? Thank you. Appreciate all the assistance.
0
 
mmoyaAuthor Commented:
Let me corerct my previous statement. Need to query folders, shortcuts and/or share names with the string name = 'ABC'
0
 
mmoyaAuthor Commented:
I tried running the last script and it's giving me incorrect UNC paths...

Could not find \\DESKTOP1\C$\Users\ on DESKTOP1
Could not find desktop folder at \\DESKTOP1\C$\Documents and Settings\All Users\Application Data\Desktop\
Could not find desktop folder at \\DESKTOP1\C$\Documents and Settings\All Users\Desktop\Desktop\
Could not find desktop folder at \\DESKTOP1\C$\Documents and Settings\All Users\Documents\Desktop\
Could not find desktop folder at \\DESKTOP1\C$\Documents and Settings\All Users\DRM\Desktop\
Could not find desktop folder at \\DESKTOP1\C$\Documents and Settings\All Users\Favorites\Desktop\
Could not find desktop folder at \\DESKTOP1\C$\Documents and Settings\All Users\Start Menu\Desktop\
Could not find desktop folder at \\DESKTOP1\C$\Documents and Settings\All Users\Templates\Desktop\
0
 
mmoyaAuthor Commented:
Ok, here are the correct locations of the shortcuts:

Windows 7 = \C$\ProgramData\Microsoft\Windows\Start Menu\Programs\

XP = \C$\Documents and Settings\All Users\Start Menu\Programs\
0
 
RobSampsonCommented:
Hi, for the output you have shown, you must have changed
arrRootPaths = Array("C:\Users\", "C:\Documents and Settings\")

to have
"C:\Documents and Settings\All Users\"

That won't quite work, because I've written the script so that it automatically tacks on "\Desktop\" to the subfolders of the root path.  For example, by having
"C:\Documents and Settings\"

it automatically gets the subfolders, being
"C:\Documents and Settings\usera"
"C:\Documents and Settings\userb"

and then adds "\Desktop\", so that it looks in
"C:\Documents and Settings\usera\Desktop\"
"C:\Documents and Settings\userb\Desktop\"

So it only searches the Desktop folder, and not subfolders of it.

Did you want it to search all folders for all profiles, or all folders for a specific root path (without automatically adding any folder names)?

Also, for each Desktop folder it finds, it will check the file names, folder names, and also the TargetPath of each .lnk file for the matching string.

Rob.
0
 
RobSampsonCommented:
So given your last comment, you want to make it search recursively for anything from the root path specified?
0
 
mmoyaAuthor Commented:
Hi Rob,

Ok, thank you for the explanation. Yes, to search it recursively would be the best way. Thank you.
0
 
RobSampsonCommented:
OK sure.  This is now recursive from each root folder that you specify.  I haven't fully tested it.

Regards,

Rob.
Const ForReading = 1
Const ForWriting = 2

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("C:\DesktopsFinal.txt", ForReading)
Set objResultFile = objFSO.OpenTextFile("C:\CheckFolderResults.txt", ForWriting, True)

arrTextFile = Split(objTextFile.ReadAll, vbCrLf)
objTextFile.Close

strNameToFind = "ABC"

arrRootPaths = Array("C:\Users\", "C:\Documents and Settings\All Users\")
For i = 0 To UBound(arrTextFile)
	strComputer = arrTextFile(i)
	If Ping(strComputer) = True Then
		For Each strRootPath In arrRootPaths
			strRootFolder = "\\" & strComputer & "\" & Replace(strRootPath, ":", "$")
			If objFSO.FolderExists(strRootFolder) = True Then
				RecurseFolder strRootFolder
			Else
				objResultFile.WriteLine "Could not find " & strRootFolder & " on " & strComputer
			End If
		Next
	Else
		objResultFile.WriteLine strComputer & " is offline"
	End If
Next

objResultFile.Close
WScript.Echo "All Done!"

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Sub RecurseFolder(strFolderPath)
	For Each objFile In objFSO.GetFolder(strFolderPath).Files
		If InStr(LCase(objFile.Name), LCase(strNameToFind)) > 0 Then  
			objResultFile.WriteLine "File found on " & strComputer & ": " & objFile.Path
		End If
		If InStr(objFile.Name, ".") > 0 Then
			If LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = ".lnk" Then
				Set objShortcut = objShell.CreateShortcut(objFile.Path)
				If InStr(LCase(objShortcut.TargetPath), LCase(strNameToFind)) > 0 Then
					objResultFile.WriteLine "Shortcut found on " & strComputer & " in " & objFile.Path & ": " & objShortcut.TargetPath
				End If
			End If
		End If
	Next
	For Each objFolder In objFSO.GetFolder(strFolderPath).SubFolders
		If InStr(LCase(objFolder.Name), LCase(strNameToFind)) > 0 Then  
			objResultFile.WriteLine "Folder found on " & strComputer & ": " & objFolder.Path
		End If
		RecurseFolder objFolder.Path
	Next
End Sub

Open in new window

0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 9
  • 6
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now