Sub Window_onLoad
arrCommands = Split(ITTool.commandLine, chr(34))
For i = 3 to (Ubound(arrCommands) - 1) Step 2
MsgBox arrCommands(i)
Next
End Sub
When I run my HTA application, I get:
arrCommands is undefined
I am trying to make an HTA app that accepts command line arguments (optional).
Your script section contains an Option Explicit statement. That makes defining variables before you can use them mandatory. Add a line Dim arrCommands, i to your procedure:
Sub Window_onLoad
Dim arrCommands, i
arrCommands = Split(ITTool.commandLine, chr(34))
For i = 3 to (Ubound(arrCommands) - 1) Step 2
MsgBox arrCommands(i)
Next
End Sub
Related
I am trying to create a VbScript file that will read a text file that has a list of folder names in it.
From these folder names I need to create a second text file that prints out all the files with a specific extension.
I have used this code to do the second part of the task
Option Explicit 'force all variables to be declared
Const ForWriting = 2
Dim objFSO 'File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objTS 'Text Stream Object
Set objTS = objFSO.OpenTextFile("C:\Output.txt", ForWriting, True)
Call Recurse("C:\")
objTS.Close()
Sub Recurse(strFolderPath)
Dim objFolder
Set objFolder = objFSO.GetFolder(strFolderPath)
Dim objFile
Dim objSubFolder
For Each objFile In objFolder.Files
'only proceed if there is an extension on the file.
If (InStr(objFile.Name, ".") > 0) Then
'If the file's extension is "pfx", write the path to the output file.
If (LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = ".exe") Then _
objTS.WriteLine(objfile.Path)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Call Recurse(objSubFolder.Path)
Next
End Sub
I have tried to put this in a loop but when I do I get a syntax error for this line Sub Recurse(strFolderPath)
Any help you can give me would be appreciated
One interpretation of
I have tried to put this in a loop but when I do I get a syntax error
for this line Sub Recurse(strFolderPath)
is that the structure of your resulting script looks like:
Do Until tsIn.AtEndOfStream
p = tsIn.ReadLine
Sub Recurse(p)
End Sub
Call Recurse(p)
Loop
output:
cscript 27537600-B.vbs
..\27537600-B.vbs(3, 4) Microsoft VBScript compilation error: Syntax error
VBScript does not allow nested Sub/Function definitions, especially in loops (you may get away with mixing simple statements and Sub/Function definitions in top-level code, but that's more a bug than a feature). If you re-structure the script like
Do Until tsIn.AtEndOfStream
p = tsIn.ReadLine
Call Recurse(p)
Loop
Sub Recurse(p)
End Sub
you won't get a syntax error on the Sub line.
There is a problem with this Windows Installer package. A program run as part of the setup did not finish as expected. Contact your support personnel or package vendor
Hey I wrote this script delete shares of a computer but when I run my script it repeats the same wscript.echo statating the share being deleted. Why does my code never end when run How do I fix that.
My fumction:
'The function that is called to run the command Line that deletes a specific share from a pc
Function DeleteThisShare(Share)
Dim objShell
'Logging The deleted Approved Shares
objDeletedFile.WriteLine (Now & " - Removed share " & Trim(Share))
DeleteThisShare = "net share " & chr(34) & Share & chr(34) &" /DELETE"
Wscript.echo DeleteThisShare
Set objShell = CreateObject("Wscript.Shell")
objShell.Run DeleteThisShare
End Function
My loops:
'Compares The UnApproved Shares to the Current Shares
For Each objItem In colItems
Dim StrNonUnapprovedShares, Item
StrCurrentShares = objItem.name
if instr(AdminShares,lcase(objitem.name)) > 0 or mid(objitem.name,2,1) = "$" or left(lcase(objitem.name),10) = "pkgsvrhost" then
'Skipping known admin share
Else
For each Item in arrUnApprovedLines
If Lcase(Item) = Lcase(strCurrentShares) Then
StrNonUnapprovedShares = (StrNonUnapprovedShares & strCurrentShares & vbCrLf)
End If
Next
End If
Next
Dim notUnapprovedShares, notUnapprovedLines
notUnapprovedLines = StrNonUnapprovedShares
notUnapprovedLines = Split(notUnapprovedLines, vbCrLf)
Dim y, Line2
For y = 0 to uBound(notUnapprovedLines)
Line2 = Trim(notUnapprovedLines(y))
If len(Line2) > 0 Then
DeleteThisShare(Line2)
End If
Next
I think the problem is caused by using the function name as a variable. That's okay with VB that you're compiling, but I don't think VBScript recognizes it in the same way. Use a separate variable name in place of DeleteThisShare, e.g. strDeleteThisShare.
If I had to guess it's because you're creating a recursive loop by having your script echo the DeleteThisShare function. The function gets to that line and is called again before it's able to carry on.
Try to only assign values to the result of the function and use local variables to store any other debugging / temporary values.
I am using a Test Driver script (testset Driver.vbs) in QTP and in it I am trying to call a function in another file. I thought I could add this to the testset driver.vbs:
Function IncludeAOA
Dim objFSO, objFile, AR1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("\\Server1\QTP Files\Community\Driver Scripts\AOAReg.vbs", 1)
AR1 = objFile.ReadAll
objFile.Close
ExecuteGlobal AR1
End Function
I call the IncludeAOA function which seems to work. But, when it gets to the ExecuteGlobal AR1 line it fails with an
Error: Invalid Character, Code: 800A0408.
Can anyone see what I missed?
AR1 - i.e. the code in AOAReg.vbs - is to blame. Try to 'run' it with cscript AOAReg.vbs. If that does not show the error (including the line number), post the code or check the encoding of that file.
I am a newbie to VBS scripting. I am getting above error on line 54, character 5 in script below. This error says "Object doesn't support this property or method: 'MimeMapArray'".
And line it is referring to is:
MimeMapArray(i) = CreateObject("MimeMap")
Can u tell me what I am doing wrong? Here is the script in its entirety. Note, I am trying to run this on an XP OS by double-clicking this VBS file.
' This script adds the necessary Windows Presentation Foundation MIME types
' to an IIS Server.
' To use this script, just double-click or execute it from a command line.
' Running this script multiple times results in multiple entries in the IIS MimeMap.
' Set the MIME types to be added
Dim MimeMapObj
Dim MimeMapArray
Dim WshShell
Dim oExec
Const ADS_PROPERTY_UPDATE = 2
Dim MimeTypesToAddArray
MimeTypesToAddArray = Array(".manifest", "application/manifest", ".xaml", _
"application/xaml+xml", ".application", "application/x-ms-application", _
".deploy", "application/octet-stream", ".xbap", "application/x-ms-xbap", _
".xps", "application/vnd.ms-xpsdocument")
' Get the mimemap object
Set MimeMapObj = GetObject("IIS://LocalHost/MimeMap")
' Call AddMimeType for every pair of extension/MIME type
For counter = 0 to UBound(MimeTypesToAddArray) Step 2
AddMimeType MimeTypesToAddArray(counter), MimeTypesToAddArray(counter+1)
Next
' Create a Shell object
Set WshShell = CreateObject("WScript.Shell")
' Stop and Start the IIS Service
Set oExec = WshShell.Exec("net stop w3svc")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
Set oExec = WshShell.Exec("net start w3svc")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
Set oExec = Nothing
' Report status to user
WScript.Echo "Windows Presentation Foundation MIME types have been registered."
' AddMimeType Sub
Sub AddMimeType(ByVal Ext, ByVal MType)
' Get the mappings from the MimeMap property.
MimeMapArray = MimeMapObj.GetEx("MimeMap")
' Add a new mapping.
i = UBound(MimeMapArray) + 1
ReDim Preserve MimeMapArray(i)
MimeMapArray(i) = CreateObject("MimeMap")
MimeMapArray(i).Extension = Ext
MimeMapArray(i).MimeType = MType
MimeMapObj.PutEx ADS_PROPERTY_UPDATE, "MimeMap", MimeMapArray
MimeMapObj.SetInfo()
End Sub
The first thing I can suggest is use cscript to execute. You can get more information that won't go away like with a message box.
Open a command prompt (go to start,
run, type CMD).
Go to the location where your script
is and type the following:
cscript scriptname.vbs
...where scriptname.vbs is the name of your script.
Second, you appear to be missing the "set" in front of your createobject line. Have a look here for reference.
That line should look like:
set MimeMapArray(i) = CreateObject("MimeMap")
In the Form_Load event of this ultralegacy app I need to transliterate over to a web app is this command/statement "WaitOn" that occurs right after the On Error GoTo...
Does anyone remember what WaitOn means?
Here's the code snippet:
Dim sCmd As String
Dim iFileHandle As Integer
Dim sFileName As String
Dim i As Integer
Dim sKeyWord As String
Dim sWindowPosition As String
Dim iWindowState As Integer
Dim sSystemId As String
Dim sMetrics() As String
On Error GoTo MainFormLoadErr
WaitOn
ReDim gsFundsUsed(0 To 0)
ReDim gsObjectsUsed(0 To 0)
Set gsActiveSpread = Nothing
.
.
.
MainFormLoadExit:
WaitOff
Close
Exit Sub
MainFormLoadErr:
MsgBox Error$(Err) & " in MainForm Load"
Resume MainFormLoadExit
There is a corresponding WaitOff down there I just found. I don't think WaitOn is part of a line label.
As #C-Pound Guru suggested, WaitOn and WaitOff were methods in one of the (many) modules of the program. Not clear from the the names of the subroutines was the fact that their task was to set the mouse pointer to the Wait Cursor, and then return to the default, later.
Sub WaitOn ()
On Error Resume Next
Screen.MousePointer = 11
End Sub
Sub WaitOff ()
On Error Resume Next
Screen.MousePointer = 0
End Sub
I've never come across a 'WaitOn' or 'WaitOff' command in VB. You might want to double-check the code to see if there's a WaitOn method written (and a WaitOff method as well). It's not a label as VB labels end with a colon (:).
What happens if you right-click and Go To Definition? And does the code currently run?
Check the references - maybe it's something from a non-standard dll.