Les différents types de raccourcis en vbs

Commenter

Contenu du snippet

'--------------------------------------------------------------------
' Script de création de raccourci d'URL, de fichier ou dossier sur le bureau
'
' Syntaxe :
' raccourci <URL>
' raccourci [<\\machine\nom_de_partage>]<nom_du_fichier> [<dossier_de_démarrage>]
' raccourci [<\\machine\nom_de_partage>]<nom_du_dossier>
'
' Le nom de fichier ou de dossier peut être complet ou relatif
' NB: ne pas oublier d'encadrer par des guillemets s'il y a
' des espaces dans les noms
' Exemples :
' raccourci http://www.google.com
' raccourci "m:\docs\rapport d'essai.doc" m:\docs
' raccourci d:\winnt\system32\drivers\etc
' raccourci \\springfield\d
'
'
'--------------------------------------------------------------------

Source / Exemple : 


Dim Shell, DesktopPath, lnk, args, fso, f
Set Shell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set args=Wscript.Arguments
If args.Count=0 Then Aide ""
lnkName=args(0)
DesktopPath=Shell.SpecialFolders("Desktop")
p=instr(1,lnkName,"://",vbTextCompare)
If p>0 Then
' URL
	nomse=Mid(lnkname,p+3)
	nomse=Replace(nomse,"www.","")
	nomse=Replace(nomse,"ftp.","")
	nomse=Replace(nomse,"/","_")
	Set lnk=Shell.CreateShortCut(DesktopPath & "\" & nomse & ".url")
	lnk.TargetPath=lnkname
	lnk.Save
	Wscript.echo "Raccourci sur l'URL " & lnkName & " créé sur le bureau"
	wscript.quit
	End If

' Fichier ou dossier
Fichier=true
' Test d'existence du fichier
If not fso.FileExists(lnkName) Then
	Fichier=false
' Test si c'est un dossier	
	If not fso.FolderExists(lnkName) Then _ 
		Aide "Le fichier ou le dossier " & lnkName & " n'existe pas!"
	End If
' Test si ressource réseau
reseau=false
hostname=""
sharename=""
If  left(lnkName,2)="\\" Then
	reseau=true
	name2=right(lnkName,len(lnkname)-2)
	p=instr(name2,"\")
	hostname=" (" & left(name2,p-1) & ")"
	resname=right(name2,len(name2)-p)
	p=instr(resname,"\")
	If p>0 Then sharename=left(resname,p-1)	Else sharename=resname
	end if

If fichier Then
	description="Raccourci sur le fichier "
	set f=fso.GetFile(lnkName)
	nom=f.name
	fullname=f.path
' Si le dossier de démarrage n'est pas spécifié, 
' on prend celui du fichier
	If args.Count=1 Then lnkPath=f.ParentFolder Else lnkPath=args(1)	
' Test d'existence du dossier de démarrage
	If not fso.FolderExists(lnkPath) Then _
		Aide "Le dossier " & lnkPath & "n'existe pas"
Else
	set f=fso.GetFolder(lnkName)
	nom=f.name
	If len(nom)=0 Then 
		nom=sharename 
		description="Raccourci sur le partage "
	else 
		description="Raccourci sur le dossier "
		end if
	fullname=f.path
	lnkPath=fullname
	End If

' extraction du nom sans extension
pospoint=InstrRev(nom, ".")
If pospoint>0 Then nomse=Left(nom,pospoint-1) Else nomse=nom
nomse=nomse & hostname
Set lnk=Shell.CreateShortCut(DesktopPath & "\" & nomse & ".lnk")
lnk.TargetPath=fullname
lnk.WorkingDirectory=lnkPath
lnk.Description=Description & nom & hostname
lnk.Save
Wscript.echo Description & lnkName & " créé sur le bureau"
Wscript.quit
'--------------------------------------------------------------------
Sub Aide(erreur)
If erreur="" Then
	msg= "Script de création de raccourci DJEBBIPGM" & VBCRLF
Else
	msg=erreur & VBCRLF
	End If
msg=msg & "--------------------------------------------" & VBCRLF
msg=msg & "Syntaxe :" & VBCRLF
msg=msg & "   raccourci <URL>" & VBCRLF
msg=msg & "   raccourci [<\\machine\partage>]<fichier> [<dossier_démarrage>]" & VBCRLF
msg=msg & "       NB: si <dossier_de_démarrage> est omis,"  & VBCRLF
msg=msg & "       le dossier du fichier est retenu" & VBCRLF
msg=msg & "   raccourci [<\\machine\partage>]<dossier>" & VBCRLF
wscript.echo msg
Wscript.Quit
End Sub
'--------------------------------------------------------------------

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (djebbipgm)