MSFN Forum: [VBScript] Making Shortcuts - MSFN Forum

Jump to content



Page 1 of 1
  • You cannot start a new topic
  • You cannot reply to this topic

[VBScript] Making Shortcuts Script not working 100% Rate Topic: -----

#1 User is offline   hyp3r 

  • Group: Members
  • Posts: 2
  • Joined: 11-December 03

Posted 11 December 2003 - 10:35 AM

I've got the below script which is not working 100% accurately. On the line it defines the target path (MyShortcut.TargetPath = .......) there's a section which goes .... & Chr(47) & "wrkgrp" ..... now Chr(47) is a /, why oh why is it appearing as a \ when the shortcut is built? Is windows in all it's "wisdom" auto-converting the character because thinks I've made a mistake?

(for all you out there who don't know much about access - I need that to be a "/"

What is going on folks? How can I force windows to accept that as a /?

Dim WSHNetwork, fso, WSHShell, MyShortcut, StartMenuPath, intDrive, strDrive, DriveFlag, AppDrive, Quote, Workgroup

Set fso = CreateObject("Scripting.FileSystemObject")
intDrive = 9 'This refers to the alphabet (9=I, 10=J etc)
DriveFlag = False

Do
strDrive = Chr(intDrive + 64) & ":"
   If fso.folderexists(strDrive & "\IBOS") Then
msgbox strDrive
 Call IdentifyAppsDrive
DriveFlag = True
   Elseif intDrive = 27 then
msgbox "The VBScript can not locate your Chase Shared Drive" & vbnewline & _ 
 vbnewline & "Please contact the BIT Team"
DriveFlag = True
   Else
intDrive = intDrive + 1
   End If
Loop Until DriveFlag = True

'*******************************************************************

Sub IdentifyAppsDrive()

intDrive = 1 'This refers to the alphabet (1=A, 2=B etc)
DriveFlag = False

Do
AppDrive = Chr(intDrive + 64) & ":"
   If fso.fileexists(AppDrive & "\W32APPS\MSOffice.97\Office\msaccess.exe") Then
AppDrive = Appdrive & "\W32APPS\MSOffice.97\Office\msaccess.exe"
Msgbox Appdrive
 Call MakeShortcut
DriveFlag = True
   Elseif fso.fileexists(AppDrive & "\Program Files\Microsoft Office\Office\msaccess.exe") Then
AppDrive = Appdrive & "\Program Files\Microsoft Office\Office\msaccess.exe"
msgbox appdrive
Call MakeShortcut
DriveFlag = True
   Elseif intDrive = 27 then
msgbox "The VBScript can not locate your app's drive" & vbnewline & _ 
 vbnewline & "Please contact the BIT Team"
DriveFlag = True
   Else
intDrive = intDrive + 1
   End If
Loop Until DriveFlag = True

End Sub

'*******************************************************************
Sub MakeShortcut()
Set WSHShell = WScript.CreateObject("WScript.Shell")
Quote = Chr(34)
WorkGroup = Chr(47) & "wrkgrp"

' Read desktop path using WshSpecialFolders object
StartMenuPath = WSHShell.SpecialFolders("StartMenu") 

if fso.fileexists(StartMenuPath & "\Overtime.lnk") then
fso.deletefile(StartMenuPath & "\Overtime.lnk")
end if 

' Create a shortcut object on the desktop
Set MyShortcut = WSHShell.CreateShortcut(StartMenuPath & "\Overtime.lnk")

' Set shortcut object properties and save it
MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings(AppDrive & Quote & " " & Quote & strDrive & "\IBOS\Overtime\Secure Overtime.mdb" & Quote & " " & Chr(47) & "wrkgrp" & " " & Quote & strDrive & "\IBOS\Overtime\eobot.mdw")
MyShortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings(strDrive & "\IBOS\Overtime")
MyShortcut.WindowStyle = 4
MyShortcut.IconLocation = WSHShell.ExpandEnvironmentStrings(strDrive & "\IBOS\Overtime\bit.ico, 0")
MyShortcut.Save

WScript.Echo "A shortcut to the Overtime database now exists on your Start Menu."

End Sub



#2 User is offline   achetnik 

  • Group: Members
  • Posts: 5
  • Joined: 08-October 03

  Posted 14 December 2003 - 01:23 PM

Solved mate !

There is an extra property called "Arguments". This is where you should store the second part of the string:
"chr(47) & WorkGroup & " " & Quote & strDrive & "IBOS\Overtime\eobot.mdw" & Quote"

I have changed some of your code to make it read easier and to make a little bit more sence. See Attached. It should work perfectly now ! The only other thing you could do is to add error trapping as you are dealing will drives which can have several different errors.

achetnik

Option Explicit

Dim Fso, WSHShell, MyShortcut, StartMenuPath, intDrive, strDrive, AppDrive, Quote, Workgroup

'*******************************************************************

Call FindFolder

'*******************************************************************

Sub FindFolder()

	Set Fso = CreateObject("Scripting.FileSystemObject")
	intDrive = 9        	'This refers to the alphabet (9=I, 10=J etc)

	Do Until intDrive = 30      	'This will Never happen !
  strDrive = Chr(intDrive + 64) & ":\"    'Should put slash with Drive
  If Fso.folderexists(strDrive & "IBOS") Then
  	Msgbox strDrive
  	Call IdentifyAppsDrive
  	Exit Do
  Elseif intDrive = 27 then
  	Msgbox "The VBScript can not locate your Chase Shared Drive" & vbnewline & vbnewline & "Please contact the BIT Team"
  	Exit Do
  Else
  	intDrive = intDrive + 1
  End If
	Loop

End Sub

'*******************************************************************


'*******************************************************************

Sub IdentifyAppsDrive()

  	'This refers to the alphabet (1=A, 2=B etc)
	intDrive = 3	'Probably not a good item to start at A:\ as you will recieve an error if there is not disk in the drive

	Do Until intDrive = 30      	'This will Never happen !
  AppDrive = Chr(intDrive + 64) & ":\"
  If Fso.Fileexists(AppDrive & "W32APPS\MSOffice.97\Office\msaccess.exe") Then
  	AppDrive = Appdrive & "W32APPS\MSOffice.97\Office\msaccess.exe"
  	Msgbox Appdrive
  	Call MakeShortcut
  	Exit Do
  Elseif Fso.Fileexists(AppDrive & "Program Files\Microsoft Office\Office\msaccess.exe") Then
  	AppDrive = Appdrive & "Program Files\Microsoft Office\Office\msaccess.exe"
  	Msgbox appdrive
  	Call MakeShortcut
  	Exit Do
  Elseif intDrive = 27 then
  	Msgbox "The VBScript can not locate your app's drive" & vbnewline & vbnewline & "Please contact the BIT Team"
  	Exit Do
  Else
  	intDrive = intDrive + 1
  End If
	Loop

End Sub

'*******************************************************************


'*******************************************************************

Sub MakeShortcut()

	Set WSHShell = WScript.CreateObject("WScript.Shell")
	Quote = Chr(34)
	WorkGroup = "wrkgrp"

          'Read desktop path using WshSpecialFolders object
	StartMenuPath = WSHShell.SpecialFolders("StartMenu") 

	If Fso.Fileexists(StartMenuPath & "\Overtime.lnk") then
  Fso.Deletefile(StartMenuPath & "\Overtime.lnk")
	End if 

          'Create a shortcut object on the start menu
	Set MyShortcut = WSHShell.CreateShortcut(StartMenuPath & "\Overtime.lnk")

          'Set shortcut object properties and save it
	MyShortcut.TargetPath = AppDrive & Quote & " " & Quote & strDrive & "IBOS\Overtime\Secure Overtime.mdb"
	MyShortcut.Arguments = chr(47) & WorkGroup & " " & Quote & strDrive & "IBOS\Overtime\eobot.mdw" & Quote
	MyShortcut.WorkingDirectory = strDrive & "IBOS\Overtime"
	MyShortcut.WindowStyle = 4
	MyShortcut.IconLocation = strDrive & "IBOS\Overtime\bit.ico, 0"
	MyShortcut.Save

	WScript.Echo "A shortcut to the Overtime database now exists on your Start Menu."

	Call CleanUp

End Sub

'*******************************************************************


'*******************************************************************

Sub CleanUp()

	Fso = ""
	WSHShell = ""
	MyShortcut = ""
	StartMenuPath = ""
	intDrive = ""
	strDrive = ""
	AppDrive = ""
	Quote = ""
	Workgroup = ""

End Sub


Share this topic:


Page 1 of 1
  • You cannot start a new topic
  • You cannot reply to this topic

1 User(s) are reading this topic
0 members, 1 guests, 0 anonymous users



All trademarks mentioned on this page are the property of their respective owners
Copyright © 2001 - 2011 msfn.org
Privacy Policy