Shortcut to a exiting folder on a netshare
Hey you guys! I do have a kind of funny problem. I'm trying to do a Custom Action VB-Script who uses the command SUBST to create a shortcut on all users\desktop. So far so good. The script creates the shortcut to point at P:\Program, at least that what i says in the targetbox.
By the way, when the VB-sripts runs there is no P: mapped.
When I then later maps P:\Program manually and trys to dbl-click och the shortcut XP dosn't know what kind of program it should use to open the shortcut with. I'm out of ideés, can someone give me a hint.
By the way, when the VB-sripts runs there is no P: mapped.
When I then later maps P:\Program manually and trys to dbl-click och the shortcut XP dosn't know what kind of program it should use to open the shortcut with. I'm out of ideés, can someone give me a hint.
0 Comments
[ + ] Show comments
Answers (1)
Please log in to answer
Posted by:
anonymous_9363
16 years ago
Why do you need SUBST? Why, indeed, are you using it? Its purpose is to map a drive to a folder.
Creating shortcuts in VBS is simple. Have some free code. A bit over-the-top but I couldn't be bothered to edit it down:
[font="courier new"]Option Explicit
Dim strMsg
Dim objFSO
Dim objWSHShell
Dim objWSHShellSysEnv
Dim objWSHShellUserEnv
Dim strAllUsersProfileFolder
Dim strUserProfileFolder
Dim strAllUsersStartProgramsFolder
Dim strUserStartProgramsFolder
Dim strShortcutTargetFolder
Dim strShortcutFolder
Dim strShortcutFileName
Dim strShortcutName
Dim strInstallDir
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSHShell = CreateObject("WScript.Shell")
Set objWSHShellSysEnv = objWSHShell.Environment("PROCESS")
Set objWSHShellUserEnv = objWSHShell.Environment("PROCESS")
strAllUsersProfileFolder = objWSHShellSysEnv("ALLUSERSPROFILE")
strUserProfileFolder = objWSHShellUserEnv("USERPROFILE")
strShortcutTargetFolder = "PDF reDirect v2"
'strInstallDir = Session.Property("INSTALLDIR")
'strInstallDir = Session.Property("CustomActionData")
'// Delete the whole shortcut folder from All Users - we're replacing some of it, not all
If Len(strAllUsersProfileFolder) > 0 Then
strAllUsersStartProgramsFolder = strAllUsersProfileFolder & "\" & "Start Menu\Programs"
strShortcutFolder = strAllUsersStartProgramsFolder & "\" & strShortcutTargetFolder
Call DeleteShortcutFolder(strShortcutFolder)
End If
'// Create new shortcuts in user's own profile folder
If Len(strUserProfileFolder) > 0 Then
strUserStartProgramsFolder = strUserProfileFolder& "\" & "Start Menu\Programs"
strShortcutFolder = strUserStartProgramsFolder & "\" & strShortcutTargetFolder
Call CreateShortcut(strShortcutFolder, "PDF reDirect.LNK", "C:\Program Files\PDF reDirect", "PDF_reDirect.exe", " -b", "C:\Program Files\PDF reDirect", 1, "C:\Program Files\PDF reDirect\PDF_reDirect.exe, 0", "", "")
Call CreateShortcut(strShortcutFolder, "PDF reDirect Help.LNK", "C:\Program Files\PDF reDirect", "PDF_Help.htm", "", "C:\Program Files\PDF reDirect", 1, "C:\Program Files\Internet Explorer\iexplore.exe, 0", "", "")
End If
'// Clean up objects
Set objWSHShellUserEnv = Nothing
Set objWSHShellSysEnv = Nothing
Set objWSHShell = Nothing
Set objFSO = Nothing
Sub DeleteShortcutFolder(ByVal strPath)
With objFSO
If .FolderExists(strShortcutFolder) Then
.DeleteFolder strShortcutFolder
'// Did we delete it?
If .FolderExists(strShortcutFolder) Then
strMsg = ""
strMsg = strMsg & "Failed to delete shortcut folder from " & strPath
End If
End If
End With
End Sub
Sub DeleteShortcut(ByVal strPath, ByVal strName)
strShortcutName = strPath & "\" & strName
On Error Resume Next
With objFSO
'// If the folder's there, find the file
If .FolderExists(strPath) Then
'// If the file's there, delete it
If .FileExists(strShortcutName) Then
.DeleteFile strShortcutName, True
'// Did we delete it?
If .FileExists(strShortcutName) Then
strMsg = ""
strMsg = strMsg & "Failed to delete shortcut " & strShortcutName
End If
End If
End If
End With
On Error Goto 0
End Sub
Sub CreateShortcut(ByVal strShortcutLocation, ByVal strShortcutName, ByVal strTargetFolder, ByVal strTargetName, ByVal strArguments, ByVal strWorkingDirectory, ByVal intWindowStyle, ByVal strIconLocation, ByVal strHotKey, ByVal strDescription)
Dim objShortcut
With objFSO
'// If the folder's NOT there, create it
If Not .FolderExists(strShortcutLocation) Then
.CreateFolder strShortcutLocation
End If
End With
Set objShortcut = objWSHShell.CreateShortcut(strShortcutLocation & "\" & strShortcutName)
'// Set shortcut object properties and save it
With objShortcut
.TargetPath = strTargetFolder & "\" & strTargetName
.Arguments = strArguments
.WorkingDirectory = strWorkingDirectory
.WindowStyle = intWindowStyle
.IconLocation = strIconLocation
'.Hotkey = strHotKey
'.Description = strDescription
.Save
End With
End Sub
Creating shortcuts in VBS is simple. Have some free code. A bit over-the-top but I couldn't be bothered to edit it down:
[font="courier new"]
Dim strMsg
Dim objFSO
Dim objWSHShell
Dim objWSHShellSysEnv
Dim objWSHShellUserEnv
Dim strAllUsersProfileFolder
Dim strUserProfileFolder
Dim strAllUsersStartProgramsFolder
Dim strUserStartProgramsFolder
Dim strShortcutTargetFolder
Dim strShortcutFolder
Dim strShortcutFileName
Dim strShortcutName
Dim strInstallDir
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSHShell = CreateObject("WScript.Shell")
Set objWSHShellSysEnv = objWSHShell.Environment("PROCESS")
Set objWSHShellUserEnv = objWSHShell.Environment("PROCESS")
strAllUsersProfileFolder = objWSHShellSysEnv("ALLUSERSPROFILE")
strUserProfileFolder = objWSHShellUserEnv("USERPROFILE")
strShortcutTargetFolder = "PDF reDirect v2"
'strInstallDir = Session.Property("INSTALLDIR")
'strInstallDir = Session.Property("CustomActionData")
'// Delete the whole shortcut folder from All Users - we're replacing some of it, not all
If Len(strAllUsersProfileFolder) > 0 Then
strAllUsersStartProgramsFolder = strAllUsersProfileFolder & "\" & "Start Menu\Programs"
strShortcutFolder = strAllUsersStartProgramsFolder & "\" & strShortcutTargetFolder
Call DeleteShortcutFolder(strShortcutFolder)
End If
'// Create new shortcuts in user's own profile folder
If Len(strUserProfileFolder) > 0 Then
strUserStartProgramsFolder = strUserProfileFolder& "\" & "Start Menu\Programs"
strShortcutFolder = strUserStartProgramsFolder & "\" & strShortcutTargetFolder
Call CreateShortcut(strShortcutFolder, "PDF reDirect.LNK", "C:\Program Files\PDF reDirect", "PDF_reDirect.exe", " -b", "C:\Program Files\PDF reDirect", 1, "C:\Program Files\PDF reDirect\PDF_reDirect.exe, 0", "", "")
Call CreateShortcut(strShortcutFolder, "PDF reDirect Help.LNK", "C:\Program Files\PDF reDirect", "PDF_Help.htm", "", "C:\Program Files\PDF reDirect", 1, "C:\Program Files\Internet Explorer\iexplore.exe, 0", "", "")
End If
'// Clean up objects
Set objWSHShellUserEnv = Nothing
Set objWSHShellSysEnv = Nothing
Set objWSHShell = Nothing
Set objFSO = Nothing
Sub DeleteShortcutFolder(ByVal strPath)
With objFSO
If .FolderExists(strShortcutFolder) Then
.DeleteFolder strShortcutFolder
'// Did we delete it?
If .FolderExists(strShortcutFolder) Then
strMsg = ""
strMsg = strMsg & "Failed to delete shortcut folder from " & strPath
End If
End If
End With
End Sub
Sub DeleteShortcut(ByVal strPath, ByVal strName)
strShortcutName = strPath & "\" & strName
On Error Resume Next
With objFSO
'// If the folder's there, find the file
If .FolderExists(strPath) Then
'// If the file's there, delete it
If .FileExists(strShortcutName) Then
.DeleteFile strShortcutName, True
'// Did we delete it?
If .FileExists(strShortcutName) Then
strMsg = ""
strMsg = strMsg & "Failed to delete shortcut " & strShortcutName
End If
End If
End If
End With
On Error Goto 0
End Sub
Sub CreateShortcut(ByVal strShortcutLocation, ByVal strShortcutName, ByVal strTargetFolder, ByVal strTargetName, ByVal strArguments, ByVal strWorkingDirectory, ByVal intWindowStyle, ByVal strIconLocation, ByVal strHotKey, ByVal strDescription)
Dim objShortcut
With objFSO
'// If the folder's NOT there, create it
If Not .FolderExists(strShortcutLocation) Then
.CreateFolder strShortcutLocation
End If
End With
Set objShortcut = objWSHShell.CreateShortcut(strShortcutLocation & "\" & strShortcutName)
'// Set shortcut object properties and save it
With objShortcut
.TargetPath = strTargetFolder & "\" & strTargetName
.Arguments = strArguments
.WorkingDirectory = strWorkingDirectory
.WindowStyle = intWindowStyle
.IconLocation = strIconLocation
'.Hotkey = strHotKey
'.Description = strDescription
.Save
End With
End Sub
Rating comments in this legacy AppDeploy message board thread won't reorder them,so that the conversation will remain readable.
