[решено] Quick Launch

[gen0m.rsw]

Такая вот проблема
Есть скрипт для создания ярлыка QuickLaunch.vbs

Set WshShell = WScript.CreateObject("WScript.Shell")
Set oShellLink = WshShell.CreateShortcut("C:\Documents and Settings\Admin\Application Data\Microsoft\Internet Explorer\Quick Launch\RegWorkshop.lnk")
oShellLink.TargetPath = "D:\RSWP\REGEDIT\RegWorkshop\RegWorkshop.exe"
oShellLink.IconLocation = "D:\RSWP\REGEDIT\RegWorkshop\RegWorkshop.exe, 0"
oShellLink.WorkingDirectory = "%SystemRoot%\system32"
oShellLink.Save

Хотелось бы что имя пользователя Admin определялось само (у всех же разные)
И имя диска D: тоже определялось автоматически, при условии что сам скрипт находиться в X:\RSWP\,
а папка RSWP всегда в корне диска, даже бывает на двух и более!

[Iska]

а папка RSWP всегда в корне диска, даже бывает на двух и более! »
Поясните.

[gen0m.rsw]

Поясните. »
Папка RSWP находиться на hdd , и на usb носителе, что бы периодически синхронизировать, но ярлыки нужны только для hdd!!!

[Iska]

gen0m.rsw, пробуйте:
Option Explicit

Dim objDrive
Dim strPath


With WScript.CreateObject("Scripting.FileSystemObject")
For Each objDrive In .Drives
If objDrive.DriveType = 2 Then
strPath = .BuildPath(objDrive.RootFolder.Path, "RSWP\REGEDIT\RegWorkshop\RegWorkshop.exe")

If .FileExists(strPath) Then
With WScript.CreateObject("WScript.Shell")
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & "\Microsoft\Internet Explorer\Quick Launch\RegWorkshop.lnk")
.TargetPath = strPath
.IconLocation = strPath & ", 0"
.WorkingDirectory = "%SystemRoot%\system32"

.Save
End With
End With

Exit For
End If
End If
Next
End With

WScript.Quit 0

[gen0m.rsw]

gen0m.rsw, пробуйте: »

Дублировал ваш скрипт для второго ярлыка, вписал пути и значения, выдал ошибку, дело в том что ярлык не один , если можно то по подробней!?

Option Explicit

Dim objDrive
Dim strPath


With WScript.CreateObject("Scripting.FileSystemObject")
For Each objDrive In .Drives
If objDrive.DriveType = 2 Then
strPath = .BuildPath(objDrive.RootFolder.Path, "RSWP\REGEDIT\RegWorkshop\RegWorkshop.exe")

If .FileExists(strPath) Then
With WScript.CreateObject("WScript.Shell")
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & "\Microsoft\Internet Explorer\Quick Launch\RegWorkshop.lnk")
.TargetPath = strPath
.IconLocation = strPath & ", 0"
.WorkingDirectory = "%SystemRoot%\system32"

.Save
End With
End With

Exit For
End If
End If
Next
End With

WScript.Quit 0



With WScript.CreateObject("Scripting.FileSystemObject")
For Each objDrive In .Drives
If objDrive.DriveType = 2 Then
strPath = .BuildPath(objDrive.RootFolder.Path, "RSWP\REGEDIT\Regshot\_Regshot.exe")

If .FileExists(strPath) Then
With WScript.CreateObject("WScript.Shell")
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & "\Microsoft\Internet Explorer\Quick Launch\Regshot.lnk")
.TargetPath = strPath
.IconLocation = strPath & ", 0"
.WorkingDirectory = "%SystemRoot%\system32"

.Save
End With
End With

Exit For
End If
End If
Next
End With

WScript.Quit 0

gen0m.rsw, пробуйте: »

Мне по проще, дублировать определённые секции, и редактировать пути!!!

Iska, gen0m.rsw, пробуйте: »

С одним ярлыком прошло!!!!

[Iska]

Option Explicit
Dim objDrive
Dim strPath
… »gen0m.rsw, код на форуме оформляется тэгом (http://forum.oszone.net/misc.php?do=bbcode#code).

выдал ошибку, »
Принято выкладывать точное сообщение об ошибке. Обычно достаточно нажать «Ctrl-C» в окне с сообщением об ошибке.

Мне по проще, дублировать определённые секции, и редактировать пути!!! »
Пробуйте (не проверялось):
[code]Option Explicit

Dim objDictionary
Dim elem

Dim strPath
Dim objDrive


Set objDictionary = WScript.CreateObject("Scripting.Dictionary")

With objDictionary
.Add "RSWP\REGEDIT\RegWorkshop\RegWorkshop.exe", "RegWorkshop.lnk"
.Add "RSWP\REGEDIT\Regshot\_Regshot.exe", "Regshot.lnk"

For Each elem In .Keys
With WScript.CreateObject("Scripting.FileSystemObject")
For Each objDrive In .Drives
If objDrive.DriveType = 2 Then
strPath = .BuildPath(objDrive.RootFolder.Path, elem)

If .FileExists(strPath) Then
With WScript.CreateObject("WScript.Shell")
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & _
"\Microsoft\Internet Explorer\Quick Launch\" & objDictionary.Item(elem))

.TargetPath = strPath
.IconLocation = strPath & ", 0"
.WorkingDirectory = "%SystemRoot%\system32"

.Save
End With
End With

Exit For
End If
End If
Next
End With
Next

.RemoveAll
End With

Set objDictionary = Nothing

WScript.Quit 0

[gen0m.rsw]

gen0m.rsw, код на форуме оформляется тэгом [code]. »
Сам хотел спросить, как енто писать!!!

[gen0m.rsw]

Iska

Всем респект!!!
Спасибо за код(добавление ярлыков в быстры запуск), намного облегчил проблему.
Option Explicit

Dim objDictionary
Dim elem

Dim strPath
Dim objDrive


Set objDictionary = WScript.CreateObject("Scripting.Dictionary")

With objDictionary
.Add "RSWP\FILE_FOLDERS\BCompare\BCompare.exe", "Beyond Compare 3.lnk"
.Add "RSWP\MANAGER\NirSoft\NirSoft\shexview.exe", "ShellExView.lnk"
.Add "RSWP\MANAGER\NirSoft\NirSoft\shmnview.exe", "ShellMenuView.lnk"
.Add "RSWP\MANAGER\PROWiSe\PROWiSe.exe", "PROWiSe.lnk"
.Add "RSWP\MANAGER\Pserv2\Pserv2.exe", "Pserv2.lnk"
.Add "RSWP\MANAGER\Starter\Starter.exe", "Starter.lnk"
.Add "RSWP\MANAGER\SysInternals\AutoRuns.exe", "AutoRuns.lnk"
.Add "RSWP\MANAGER\Total_Commander\Totalcmd.exe", "Total Commander.lnk"
.Add "RSWP\REGEDIT\Regshot\Regshot.exe", "Regshot.lnk"
.Add "RSWP\REGEDIT\RegWorkshop\RegWorkshop.exe", "RegWorkshop.lnk"
.Add "RSWP\REGEDIT\SysTracer_Pro\SysTracer.exe", "SysTracer.lnk"
.Add "RSWP\UNINSTALL\UninstallTool\UninstallTool.exe", "UninstallTool.lnk"
.Add "RSWP\UPROVLENIE\RestartExplorer.exe", "Restart Explorer.lnk"

For Each elem In .Keys
With WScript.CreateObject("Scripting.FileSystemObject")
For Each objDrive In .Drives
If objDrive.DriveType = 2 Then
strPath = .BuildPath(objDrive.RootFolder.Path, elem)

If .FileExists(strPath) Then
With WScript.CreateObject("WScript.Shell")
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & _
"\Microsoft\Internet Explorer\Quick Launch\" & objDictionary.Item(elem))

.TargetPath = strPath
.IconLocation = strPath & ", 0"
.WorkingDirectory = "%SystemRoot%\system32"

.Save
End With
End With

Exit For
End If
End If
Next
End With
Next

.RemoveAll
End With
Нельзя ли енто чуть чуть усовершенствовать, что-бы на рабочий стол ярлыки можно было выводить!!
Сам данный скрипт всегда находиться в папке RSWP, а сама папка(RSWP), всегда в корне диска, не обязательно на одном(у меня и на харде и на флэше)!!!!
Заранее спасибо

[Iska]

что-бы на рабочий стол ярлыки можно было выводить!! »
Замените:
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & _
"\Microsoft\Internet Explorer\Quick Launch\" & objDictionary.Item(elem))

на:
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:Desktop").Self.Path & "\" & objDictionary.Item(elem))

[gen0m.rsw]

Iska
Замените:
Код: »

Ярлыки добавляются на десктоп, но хотелось бы реализовать одном скрипте!!!!

[Iska]

рлыки добавляются на десктоп, но хотелось бы реализовать одном скрипте!!!! »
Продублируйте код:
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & _
"\Microsoft\Internet Explorer\Quick Launch\" & objDictionary.Item(elem))

.TargetPath = strPath
.IconLocation = strPath & ", 0"
.WorkingDirectory = "%SystemRoot%\system32"

.Save
End With

и сделайте замену строки во втором дубле.

[gen0m.rsw]

Продублируйте код: »

Забыл сказать то, ярлыки для десктопа другие, а не те что для QuickLaunch прописаны!!!!

[Iska]

Забыл сказать то, ярлыки для десктопа другие, а не те что для QuickLaunch прописаны!!!! »
Продублируйте весь кусок кода:
With objDictionary
…
End With
Замените во втором:
.Add "RSWP\REGEDIT\RegWorkshop\RegWorkshop.exe", "RegWorkshop.lnk"
.Add "RSWP\REGEDIT\Regshot\_Regshot.exe", "Regshot.lnk"

на потребное. Там же замените:
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & _
"\Microsoft\Internet Explorer\Quick Launch\" & objDictionary.Item(elem))
на:
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:Desktop").Self.Path & "\" & objDictionary.Item(elem))

[gen0m.rsw]

Iska , все ОК!!! Респект!!!

[gen0m.rsw]

Iska, прошу Вашей помощи!
Возникла необходимость добавления ярлыков(тоже разных) в папку "Автозагрузка"в Ентот скрипт, условия теже
все проги из той же папки, далее код
' ----- ExeScript Options Begin -----
' ScriptType: window,invoker
' DestDirectory: temp
' Icon: D:\RSWP\_AUTORUN\mainicon.ico
' OutputFile: D:\RSWP\add_quick_launch.exe
' ----- ExeScript Options End -----
Option Explicit

Dim objDictionary
Dim elem

Dim strPath
Dim objDrive


Set objDictionary = WScript.CreateObject("Scripting.Dictionary")

' Добавление ярлыков в "Быстрый запуск"
With objDictionary
.Add "RSWP\FILE_FOLDERS\Beyond_Compare\BCompare.exe", "Beyond Compare 3.lnk"
.Add "RSWP\FILE_FOLDERS\Locate32\locate32.exe", "Locate32.lnk"
.Add "RSWP\HDD_UTILITES\BOOTICE\BOOTICEx86_ru.exe", "BootIce.lnk"
.Add "RSWP\MANAGER\NirSoft\NirSoft\shexview.exe", "ShellExView.lnk"
.Add "RSWP\MANAGER\PROWiSe\PROWiSe.exe", "PROWiSe.lnk"
.Add "RSWP\MANAGER\Pserv2\Pserv2.exe", "Pserv2.lnk"
.Add "RSWP\MANAGER\Starter\Starter.exe", "Starter.lnk"
.Add "RSWP\MANAGER\SysInternals\AutoRuns.exe", "AutoRuns.lnk"
.Add "RSWP\MANAGER\SysInternals\ProcExp.exe", "Process Explorer.lnk"
.Add "RSWP\MANAGER\SysTracer\SysTracer.exe", "SysTracer.lnk"
.Add "RSWP\MANAGER\SysTracer_Pro\SysTracer.exe", "SysTracer Pro.lnk"
.Add "RSWP\MANAGER\Total_Commander\Totalcmd.exe", "Total Commander.lnk"
.Add "RSWP\MULTIMEDIA\1by1\1by1.exe", "1by1.lnk"
.Add "RSWP\REGEDIT\Registry_Workshop\RegWorkshop.exe", "RegWorkshop.lnk"
.Add "RSWP\REGEDIT\Regshot\Regshot.exe", "RegShot.lnk"
.Add "RSWP\UNINSTALL\UNINSTALL_TOOL\UninstallTool.exe", "Uninstall Tool.lnk"
.Add "RSWP\HDD_UTILITES\QEMUBOOTTESTER\QemuBootTester.exe", "QemuBootTester.lnk"


For Each elem In .Keys
With WScript.CreateObject("Scripting.FileSystemObject")
For Each objDrive In .Drives
If objDrive.DriveType = 2 Then
strPath = .BuildPath(objDrive.RootFolder.Path, elem)

If .FileExists(strPath) Then
With WScript.CreateObject("WScript.Shell")
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:AppData").Self.Path & _
"\Microsoft\Internet Explorer\Quick Launch\" & objDictionary.Item(elem))

.TargetPath = strPath
.IconLocation = strPath & ", 0"
.WorkingDirectory = "%SystemRoot%\system32"

.Save
End With
End With

Exit For
End If
End If
Next
End With
Next

.RemoveAll
End With


' Добавление ярлыков на "Рабочий стол"
With objDictionary
' .Add "RSWP\CD-DVD\UltraISO\UltraISO.exe", "UltraISO.lnk"
' .Add "RSWP\FILE_FOLDERS\Directory_Monitor\DirectoryMonitor.exe", "Directory Monitor.lnk"
' .Add "RSWP\MANAGER\Total_Commander\Totalcmd.exe", "Total Commander.lnk"

For Each elem In .Keys
With WScript.CreateObject("Scripting.FileSystemObject")
For Each objDrive In .Drives
If objDrive.DriveType = 2 Then
strPath = .BuildPath(objDrive.RootFolder.Path, elem)

If .FileExists(strPath) Then
With WScript.CreateObject("WScript.Shell")
With .CreateShortcut(WScript.CreateObject("Shell.Application").NameSpace("shell:Desktop").Self.Path & "\" & objDictionary.Item(elem))

.TargetPath = strPath
.IconLocation = strPath & ", 0"
.WorkingDirectory = "%SystemRoot%\system32"

.Save
End With
End With

Exit For
End If
End If
Next
End With
Next

.RemoveAll
End With




Set objDictionary = Nothing

WScript.Quit 0

Заранее спасибо!
С уважением gen0m.rsw (https://cloud.mail.ru/public/MvN3/FXJQRdSRE)