subscript out of range in vbscript - vbscript

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)

Related

Convert batch to VBS script

I am running this command remotely in a VBS script file. The problem I am having is that it generates a CMD window momentarily and it distracts some users. How can I run this without generating the CMD window? Preferably, I want to get the WMI data in native VBS language without using oShell.run? I rather not use CMD. Thanks.
oShell.run "cmd /c wmic logicaldisk get name,providername,description,volumename,filesystem /format:list > c:\users\%username%\drives.txt"
Or you could just use what you've already got and pass the 'hidden window' parameter to the Run command (see the second parameter of 0 below):
Dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "cmd /c wmic logicaldisk get name,providername,description,volumename,filesystem /format:list > c:\users\%username%\drives.txt", 0, true
Set objShell = Nothing
You can give a try for this code in pure vbscript :
Option Explicit
Dim Ws,ReportFile,strHomeFolder
Set Ws = CreateObject("WScript.Shell")
strHomeFolder = Ws.ExpandEnvironmentStrings("%USERPROFILE%")
ReportFile = strHomeFolder & "\drives.txt"
'MsgBox GetDrives_Information
Call WriteReport(GetDrives_Information,ReportFile)
'-------------------------------------------------------
Function GetDrives_Information()
Dim oFSO,report,objWMIService,objLogicalDisk
Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oDrives
Set oDrives = oFSO.Drives
Dim oDrive
Dim strLectType
on error resume next
For Each oDrive in oDrives
If oDrive.IsReady Then
Select Case oDrive.DriveType
Case 0: strLectType = "Unknown"
Case 1: strLectType = "Amovible (USB)"
Case 2: strLectType = "Fixe (Hard Drive)"
Case 3: strLectType = "Network"
Case 4: strLectType = "CD-Rom"
Case 5: strLectType = "Virtuel"
End Select
report = report & "- Drive letter: " & oDrive.DriveLetter & vbCrLf
report = report & "- serial number: " & oDrive.SerialNumber & vbCrLf
report = report & "- Drive Type: " & oDrive.strLectType & vbCrLf
If (oDrive.FileSystem <> "") Then
report = report & "- File system used : " & oDrive.FileSystem & vbCrLf
End If
Set objWMIService = GetObject("winmgmts:")
Set objLogicalDisk = objWMIService.Get("Win32_LogicalDisk.DeviceID='" & oDrive.DriveLetter & ":'")
report = report & "- There is " & objLogicalDisk.FreeSpace /1024\1024+1 & " Mo remaining space on this drive / disk" & vbCrLf
report = report & "- There is " & objLogicalDisk.Size /1024\1024+1 & " Mo total space on this drive / disk" & vbCrLf
End If
report = report & vbCrLf
Next
GetDrives_Information = report
End Function
'-------------------------------------------------------
Sub WriteReport(strText,ReportFile)
Dim fs,ts
Const ForWriting = 2
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(ReportFile,ForWriting,True)
ts.WriteLine strText
ts.Close
End Sub
'------------------------------------------------------

Make all VBS files into one

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.

Reading text file gives me weird string chain. cant get throu making a string variable of lines in text file

I am trying to make a little script in VBS that saves command output to text file and then reading line by line from it and placing it straigh to variable.
Unfortunetly effects are weird. Instead of having a string with all lines from file I have weird chain like "ybN" (see the screenshot below). I tried to read file with many different ways found on the Internet but effects are worse or the same.
I noticed that command output is saving with many spaces after each text but I don't know if that's what causing the problem.
Any Suggestions?
Const ForWriting = 2
Const ForReading = 1
Set WshShell = CreateObject("WScript.Shell")
If WScript.Arguments.Length = 0 Then
Set ObjShell = CreateObject("Shell.Application")
ObjShell.ShellExecute "wscript.exe" _
, """" & WScript.ScriptFullName & """ RunAsAdministrator", , "runas", 1
WScript.Quit
End If
Set fsoObject = CreateObject("Scripting.FileSystemObject")
strFile = "D:\interfaces.txt"
WshShell.Run("%comspec% /C wmic nic where " & Chr(34) & "netconnectionid like '%'" & Chr(34) & " get netconnectionid >> " & Chr(34) & strFile & Chr(34))
WScript.Echo "Interface data pushed to text file at " & strFile
If fsoObject.FileExists(strFile) Then
If fsoObject.GetFile(strFile).Size <> 0 Then
Set objFile = fsoObject.OpenTextFile(strFile, ForWriting)
objFile.Write ""
objFile.Close
End If
End If
Set objFile = fsoObject.OpenTextFile(strFile, ForReading)
Do Until objFile.AtEndOfStream
strMsg = strMsg & objFile.ReadLine & vbNewLine
'strMsg = strMsg & strLine & vbNewLine
Loop
objFile.Close
sInput = InputBox("Choose network connection to configurate " & vbNewLine & strMsg, ,"Choose one option")
Screenshots:
Your file is Unicode-encoded (little endian UTF-16 to be precise). ÿþ is the byte order mark (BOM) for this encoding. You need to open it as such by setting the fourth parameter of OpenTextFile() to -1:
Set objFile = fsoObject.OpenTextFile(strFile, ForReading, False, -1)

TargetPath is blank - on remote drives

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
==>

Get a VBS file to scan computer for a file

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

Resources