I'm struggling... used google and have come up with no answers to this one!
I have a code that I'm intending to run at user logon which will find a shortcut and update the shortcut location to reflect some network changes - but the shortcut has spaces in it and VBS won't find the full target path... HELP!!!
The current target of the shortcut is:
\\LANG-APPS2\Mandata\Warehouse\Programs\StartApp.exe /sWH /ip192.168.73.124
But it will only return the bit up to .exe - it misses the last bit of /sWH /ip192.168.73.124
Here's my script:
On Error Resume Next
wscript.echo "Checking Warehouse Shortcut..."
Dim fso, folder, files, sFolder
Set fso = CreateObject("Scripting.FileSystemObject")
Set Shell = CreateObject("WScript.Shell")
sFolder = Shell.SpecialFolders("Desktop")
Set folder = fso.GetFolder(sFolder)
Set files = folder.Files
For each folderIdx In files
fullname = fso.GetAbsolutePathName(folderIdx)
Set shortcut = Shell.CreateShortcut(fullname)
shortTarget = LCase(shortcut.TargetPath)
shortWorkPath = shortcut.WorkingDirectory
lnkFind = ".lnk"
lnkSearch = instr(fullname, lnkfind)
if lnkSearch > 0 then
srvFind = "lang-apps2\mandata\warehouse\programs\startapp.exe"
srvSearch = instr(shortTarget, srvFind)
if srvSearch > 0 then
pracFind = "Practice"
pracSearch = instr(fullname, pracFind)
if pracSearch > 0 then
wscript.echo "Warehouse Practice Shortcut Needs Updating!"
wscript.echo "Please wait while I sort that out for you......"
shortcut.TargetPath = """\\Lang-man\Warehouse\Programs\StartApp.exe /sWHPRAC /ip192.168.73.134"""
shortcut.WorkingDirectory = "\\Lang-man\Warehouse\Programs"
shortcut.save
wscript.echo "Warehouse Practice Shortcut Updated!"
else
wscript.echo "Warehouse Live Shortcut Needs Updating!"
wscript.echo "Please wait while I sort that out for you......"
shortcut.TargetPath = """\\Lang-man\Warehouse\Programs\StartApp.exe /sWH /ip192.168.73.134"""
shortcut.WorkingDirectory = "\\Lang-man\Warehouse\Programs"
shortcut.save
wscript.echo "Warehouse Live Shortcut Updated!"
end if
end if
end if
set shortTarget=nothing
set shortWorkPath=nothing
set shortcut=nothing
next
wscript.echo "Finished"
From the description of the TargetPath property on MSDN (bold added by me):
This property is for the shortcut's target path only. Any arguments to the shortcut must be placed in the Argument's property.
Related
A previous team where I work created a vbs script that can automatically start a restore of a Macrium Image File located on inserted optical media. The problem is that the Macrium Image File is now too big for one disc, and now we have it split onto 2 separate discs, so now the vbs script doesn't function the way it should.
When Automatic Restore is launched, it should detect disc 1, which ends in 00.00.mrimg and know that it is part of a multi-disc install, at which point it asks for the next disc, ending in 00-01.mrimg.
I know this probably makes no sense, especially if anyone reading is not familiar with Macrium. But I will do my best to answer any questions.
I would normally plug away and try to figure it out myself, but i'm not very familiar with VBS and the problem is pretty time sensitive. Any help I can get will be much appreciated.
Opened AutoRestore.vbs script to see if I could fix the issue, but I don't know enough about vbs to fix it.
'AutoRestore.vbs
Dim fso, d, dc, s, n , Root, u, racine, folder, folderName, restoreString, foundFile, cdDrive
Dim wipe
Dim objShell
Set objShell = WScript.CreateObject("WScript.shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
foundFile = false
restoreString = "00-00.mrimg"
For Each d in dc
Root = d.Driveletter & ":"
racine = d.Driveletter & ":\"
u= Detect(Root)
if (( u="CD-ROM") ) then
cdDrive = cdDrive & racine & " "
if (d.isReady) then
folderName = racine & "IAS\"
Set folder = fso.GetFolder(folderName)
end if
end if
Next
If IsNull(folder) or IsEmpty(folder) Then
MsgBox "Could not locate IAS folder containing restore image." & vbCrLf & "The following optical disk drives were searched: " & cdDrive & vbCrLf & "Please verify the media is the drive or use manual restore.", 48, "Folder Not Found"
Else
For each file in folder.Files
If instr(1,file.Name, restoreString, vbTextCompare) > 0 Then
return = objShell.run("""%ProgramFiles%\macrium\diskrestore.exe""" & folderName & file.Name & " -r -g -u --targetnum 0 --reboot --eject",1,false)
foundFile = true
Exit For
End If
Next
if (foundFile = false) Then
MsgBox "Cannot locate .mrimg file in " & folderName & "." & vbCrLf & "Please use manual restore.", 48, "File Not Found"
End If
End If
Function Detect(DrivePath)
Dim fso, d, s, t
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(fso.GetDriveName(fso.GetAbsolutePathName(DrivePath)))
Select Case d.DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
Detect = t
End Function
Expected Results: Run AutoRestore.vbs, the script sees the 00-00.mrimg file in IAS folder of the optical media, then prompts to insert the optical media containing the 00-01.mrimg file.
Actual Results: Run AutoRestore.vbs, then Macrium states "Backup set is not complete. At least one file may be missing."
You could first copy all the mrimg files to a temporary folder on the machine's hard drive. Once you have them all, you can then run Disk Restore with that folder instead of the CD-ROM drive.
Most of your existing code would work. After the For Each d in dc loop, you know the drive where the discs are being inserted. You could add another loop:
Dim tempFolder
Set tempFolder = fso.GetFolder("C:\AutoRestore\")
Do While MsgBox("Please insert disc and click OK. When all discs have been inserted, click Cancel", vbOKCancel, "Auto Restore") = vbOK
For Each file In folder.Files
If InStr(1, file.Name, ".mrimg") > 0 Then
' Copy file to Temp folder
fso.CopyFile file.Path, tempFolder.Path & "\", True
End If
Next
Loop
After this, you should have all the mrimg files in the tempFolder location. I am not familiar with the parameters the Marcium command expects but this is where you would specify the new folder:
objShell.run("""%ProgramFiles%\macrium\diskrestore.exe""" & tempFolder.Path & "\" & file.Name & " -r -g -u --targetnum 0 --reboot --eject",1,false)
I need help with this script. This script creates a new desktop shortcut and then deletes another one. However I want it to delete one desktop shortcut if it exists or another if it exists. Not sure how to do this. I've put the 2 different shortcuts in after the "fso.deletefile" but I'm not sure what syntax to use (how to word it.) I'm new to vbs. Thanks in advance for the help.
L_Welcome_MsgBox_Message_Text = "A shortcut to the PM Master" & vbcrlf & "will be created on your desktop."
L_Welcome_MsgBox_Title_Text ="Windows Scripting Host Sample"
Call Welcome()
Dim WSHShell
Set WSHShell =CreateObject("WScript.Shell")
Dim MyShortcut, MyDesktop, DesktopPath
' Read desktop path using WshSpecialFolders object
DesktopPath =WSHShell.SpecialFolders("Desktop")
' Create a shortcut object on the desktop
Set MyShortcut =WSHShell.CreateShortcut(DesktopPath & "\PM-Master-ALL.lnk")
' Set shortcut object properties and save it
MyShortcut.TargetPath =WSHShell.ExpandEnvironmentStrings( "c:\Local Cloud\Shared\Sites\Bailey Lane\PM-Master-ALL")
MyShortcut.Save
Set Shell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
DesktopPath = Shell.SpecialFolders("Desktop")
FSO.DeleteFile DesktopPath & "\PM Master - ALL.lnk"
FSO.DeleteFile DesktopPath & "\PM Master - ALL - Shortcut.lnk"
WScript.Echo "A shortcut to the PM Master has been successfully created. The older PM Master shortcut has been deleted."
Sub Welcome()
Dim intDoIt
intDoIt = MsgBox(L_Welcome_MsgBox_Message_Text, vbOKCancel + vbInformation, L_Welcome_MsgBox_Title_Text )
If intDoIt = vbCancel Then
WScript.Quit
End If
End Sub
When in doubt, read the documentation. You can use the FileExists method to check whether a file exists before attempting to delete it:
shortcut = DesktopPath & "\PM Master - ALL.lnk"
If FSO.FileExists(shortcut) Then FSO.DeleteFile shortcut
Let's say I have a nethood link to a folder with the name "BLABLA" and the target path is "\\servername\temp"
how do I get the string for the target path?
I tried:
Set oShell = CreateObject("WScript.Shell")
Const NET_HOOD = &H13&
Set oShApp = CreateObject("Shell.Application")
sNetHood = oShApp.NameSpace(NET_HOOD).Self.Path
Set oShortCut = oShell.CreateShortcut(sNetHood & "\" & "BLABLA" & ".lnk")
MsgBox "> " & oShortCut.TargetPath
It does everything, even creates a oShortCut object without any errors.
But, it does not return
oShortCut.TargetPath
what am I doing wrong?
I'd like it to return this: "\\servername\temp\BLABLA"
Thanks in advance for any advice!
I've created the shortcut under win 7 with right click in Computer view of the explorer and then > Add a network location > Next ... etc. It creates a Folder representing a shortcut in NetHood to the path on the server ... it's like a mapped share but not really it.
thx for the input ... after years of reading myself into the matter and then checking google once more i found a c# code which i wrote into vbs and then simplified only to see that all i had to change in the end was to add this:
.GetLink
so the solution to my problem is:
Const NET_HOOD = &H13&
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.NameSpace(NET_HOOD)
For Each oFile In oFolder.Items
MsgBox oFile.GetLink.Path
Next
I am writing a script to determine the combined size of all instances of a particular subfolder within the profile folder of each user who has logged onto a Windows 2003 server, e.g. all users' desktop folders or all users' local settings folders.
Option Explicit
Dim colSubfolders, intCount, intCombinedSize, objFolder2, objFSO1, objFSO2, objUserFolder, strOutput, objSearchFolder, objSubfolder, strSearchFolder, strSubfolderPath
intCount = 0
intCombinedSize = 0
strSearchFolder = "C:\Documents and Settings\"
Set objFSO1 = CreateObject("Scripting.FileSystemObject")
Set objSearchFolder = objFSO1.GetFolder(strSearchFolder)
Set colSubfolders = objSearchFolder.SubFolders
For Each objUserFolder in colSubfolders
strSubfolderPath = objUserFolder.Path & "\Desktop\"
Set objFSO2 = CreateObject("Scripting.FileSystemObject")
Set objSubfolder = objFSO2.GetFolder(strSubfolderPath)
intCount = intCount + 1
intCombinedSize = intCombinedSize + objSubfolder.Size
Next
MsgBox "Combined size of " & CStr(intCount) & " folders: " & CStr(intCombinedSize / 1048576) & " MB"
This code throws a 'Path not found' error (Code 800A004C) at line 15:
Set objSubfolder = objFSO2.GetFolder(strSubfolderPath)
If I print out strSubfolderPath, however, I find that all the strings returned are valid directory paths, so I don't understand why I'm getting this error.
I've tried with and without the trailing backslash at the end of the path and I've tried with 8.3 style paths to remove spaces but to no effect.
When I run your code I get the same error.
Upon further inspection, on my computer there is a folder named C:\Documents and Settings\machinename, where machinename is the name of my computer. This folder only contains one subfolder named ASPNet.
I'm guessing you have something similar.
To minimize multiple-backslash confusion, use the FileSystemObject methods consistently instead of relying on string concatenation:
strSubfolderPath = objFSO1.BuildPath(objUserFolder.Path,"Desktop")
I have a VBScript that checks for the existence of a file in a directory on a remote machine. I am looking to retrieve the "Product Version" for said file (NOT "File Version"), but I can't seem to figure out how to do that in VBScript.
I'm currently using Scripting.FileSystemObject to check for the existence of the file.
Thanks.
I use a function that is slightly modified from the previous example. The function takes the path and file name and returns the "Product Version"
Function GetProductVersion (sFilePath, sProgram)
Dim FSO,objShell, objFolder, objFolderItem, i
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sFilePath & "\" & sProgram) Then
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(sFilePath)
Set objFolderItem = objFolder.ParseName(sProgram)
Dim arrHeaders(300)
For i = 0 To 300
arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i)
'WScript.Echo i &"- " & arrHeaders(i) & ": " & objFolder.GetDetailsOf(objFolderItem, i)
If lcase(arrHeaders(i))= "product version" Then
GetProductVersion= objFolder.GetDetailsOf(objFolderItem, i)
Exit For
End If
Next
End If
End Function
I've found that the position of the attributes has occasionally changes (not sure why) in XP and Vista so I look for the "product version" attribute and exit the loop once it's found. The commented out line will show all the attributes and a value if available
You can use the Shell.Namespace to get the extended properties on a file, one of which is the Product Version. The GetDetailsOf function should work. You can test with the following code to get an idea:
Dim fillAttributes(300)
Set shell = CreateObject("Shell.Application")
Set folder = shell.Namespace("C:\Windows")
Set file = folder.ParseName("notepad.exe")
For i = 0 to 299
Wscript.Echo i & vbtab & fillAttributes(i) _
& ": " & folder.GetDetailsOf(file, i)
Next
One thing to be aware of:
The extended properties of a file differs between versions of Windows. Hence, the product version index numbers changes based on the version of Windows you are using. You can use the code above to determine what they are. From my testing, I believe they are as follows:
Window XP - 39
Windows Vista - 252
Windows 7 - 268
Windows 2008 R2 SP1 - 271
Windows 2012 R2 - 285
You may also find the following post helpful.
The product version can be retrieved directly with the ExtendedProperty method.
function GetProductVersion(Path)
dim shell, file
set shell = CreateObject("Shell.Application")
const ssfDesktop = 0
set file = shell.Namespace(ssfDesktop).ParseName(Path)
if not (file is nothing) then
GetProductVersion = _
file.ExtendedProperty("System.Software.ProductVersion")
end if
end function
By contrast with a couple of older answers,
This does not require looping over an unknown or arbitrary number of columns with GetDetailsOf.
This uses the canonical name of the property, not the display name. One can also use the FMTID and PID: "{0CEF7D53-FA64-11D1-A203-0000F81FEDEE} 8".
This avoids the need to split the path into directory and name, by starting at the root (desktop) namespace.
' must explicitly declare all variables
Option Explicit
' declare global variables
Dim aFileFullPath, aDetail
' set global variables
aFileFullPath = "C:\Windows\Notepad.exe"
aDetail = "Product Version"
' display a message with file location and file detail
WScript.Echo ("File location: " & vbTab & aFileFullPath & vbNewLine & _
aDetail & ": " & vbTab & fGetFileDetail(aFileFullPath, aDetail))
' make global variable happy. set them free
Set aFileFullPath = Nothing
Set aDetail = Nothing
' get file detail function. created by Stefan Arhip on 20111026 1000
Function fGetFileDetail(aFileFullPath, aDetail)
' declare local variables
Dim pvShell, pvFileSystemObject, pvFolderName, pvFileName, pvFolder, pvFile, i
' set object to work with files
Set pvFileSystemObject = CreateObject("Scripting.FileSystemObject")
' check if aFileFullPath provided exists
If pvFileSystemObject.FileExists(aFileFullPath) Then
' extract only folder & file from aFileFullPath
pvFolderName = pvFileSystemObject.GetFile(aFileFullPath).ParentFolder
pvFileName = pvFileSystemObject.GetFile(aFileFullPath).Name
' set object to work with file details
Set pvShell = CreateObject("Shell.Application")
Set pvFolder = pvShell.Namespace(pvFolderName)
Set pvFile = pvFolder.ParseName(pvFileName)
' in case detail is not detected...
fGetFileDetail = "Detail not detected"
' parse 400 details for given file
For i = 0 To 399
' if desired detail name is found, set function result to detail value
If uCase(pvFolder.GetDetailsOf(pvFolder.Items, i)) = uCase(aDetail) Then
fGetFileDetail = pvFolder.GetDetailsOf(pvFile, i)
End If
Next
' if aFileFullPath provided do not exists
Else
fGetFileDetail = "File not found"
End If
' make local variable happy. set them free
Set pvShell = Nothing
Set pvFileSystemObject = Nothing
Set pvFolderName = Nothing
Set pvFileName = Nothing
Set pvFolder = Nothing
Set pvFile = Nothing
Set i = Nothing
End Function
Wscript.Echo CreateObject("Scripting.FileSystemObject").GetFileVersion("C:\Windows\notepad.exe")