Discussion :

[maxxgraph]

Bonjour à tous,

Je cherche à créer une commande pour le menu "Envoyer vers"

Dans le cadre professionnel, j'ai un répertoire qui contient l'ensemble de nos affaires avec un dossier par affaire, le tout héberger sur un disque réseau.

Sur mon poste, j'ai un répertoire où je créer et stock les raccourci vers les dossiers de ces affaires, en tous cas celles qui me concernent.

Je souhaite rajouter une commande dans le menu "Envoyer vers" (Batch ou VBS) qui créer un raccourci du dossier sélectionné sur le disque réseau, dans le répertoire de mon poste qui contient mes raccourci.

J'ai commencer à regarder du coté de la commande OptimumX "Shortcut" mais malheureusement, je n'arrive à pas l'exploiter ...

Si quelqu'un à la réponse ou un bout de réponse, je suis preneur !

En vous remerciant d'avance.
Bonne journée.

[maxxgraph]

J'ai réussi à trouver un code en VBS que j'ai adapté.

A la base, il est utilisé pour inserer des raccourci d'application, de dossier ou de fichiers dans le QuickLaunch.

En espérant que cela peut être utile pour certains. !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'COPYRIGHT NOTICE: This script and all material at Winhelponline.com are registered with...
'"The UK Copyright Service". No part of the Website or script can be distributed or ...
'republished without the author's written permission.
'Copyright © 2008 by Ramesh Srinivasan. All rights reserved.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'SendtoQL.vbs - Adds "Quick Launch (create shortcut)" option to the "Send To" menu.
'Sends a file (as shortcut) to the Quick Launch folder.
'For Windows XP and Windows Vista systems.
'Homepage: http://www.winhelponline.com/blog/
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
'Version History:
'(ver 1.0) June 16, 2008
'(ver 1.1) July 20, 2008 (Add support for directories)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strQLFolder =  "D:\0Bin\En cours"
strSendTo = WshShell.SpecialFolders("SendTo") & "\"
strShortcutFileName = strSendTo & "\" & "Quick Launch (create shortcut)" & ".lnk"
strMsg = "Completed!" & Chr(10) & Chr(10) & "SendToQuickLaunch.vbs - © 2008 Ramesh Srinivasan" & Chr(10) & "Visit us at http://www.winhelponline.com/blog/"
Set objArgs = WScript.Arguments
If WScript.Arguments.Count >  0 Then
	For I = 0 to objArgs.Count - 1
		If objFSO.FileExists(objArgs(I)) then
			Set objFile = objFSO.GetFile(objArgs(I))
			strFileName = objFSO.GetAbsolutePathName(objArgs(I))
			strBaseName = objFSO.GetBaseName(objArgs(I))
			strFileext = lcase(objFSO.GetExtensionName(objArgs(I)))
			SendtoQL strFileName,strFileext,strBaseName
		End If
		
		If objFSO.FolderExists(objArgs(I)) Then	
			strFolderName = objFSO.GetAbsolutePathName(objArgs(I))
			strBaseName = objFSO.GetBaseName(objArgs(I))
			strFileext = "directory"
			SendtoQL strFolderName,strFileext,strBaseName		
		End If	
	Next
Else
	rtn= Trim(UCase(InputBox ("Type INSTALL to add the QUICK LAUNCH (SHORTCUT) to the Send To menu, or type UNINSTALL if you wish to remove the QUICK LAUNCH (SHORTCUT) option.", 	"Configuring SendToQuickLaunch.vbs...", "INSTALL")))
	If rtn = "INSTALL" Then RunInstall
	If rtn = "UNINSTALL" Then RunUninstall
End If

Sub SendtoQL(fname,fextn,basename)
	Select Case fextn
		Case "lnk"
			objFSO.CopyFile fname, strQLFolder
	
		Case "url"
			objFSO.CopyFile fname, strQLFolder				
	
		Case Else		
			Set oShellLink = WshShell.CreateShortcut(strQLFolder & "\" & basename & ".lnk")
			oShellLink.TargetPath = fname
			oShellLink.Save	
	End Select
End Sub

Sub RunInstall
	Set oShellLink = WshShell.CreateShortcut(strShortcutFileName)
	oShellLink.TargetPath = WScript.ScriptFullName
	oShellLink.IconLocation = "shell32.dll,39"
	oShellLink.Save
	MsgBox strMsg, vbokonly,"Installed"
End Sub

Sub RunUninstall
	if objFSO.fileexists(strShortcutFileName) then objFSO.deletefile(strShortcutFileName)
	MsgBox strMsg, vbokonly,"Uninstalled"
End Sub