Expected "End" Code - vbscript

I am getting this error for the code below on the second to last line Char 13. I cannot see any problem with the code. Is someone able to help?
Function Results(KBname)
Select Case Return
Case 9009
LogFile.WriteLine(Now & " - WARNING: " & KBname & " is already installed; skipping installation.")
Case 2359302
LogFile.WriteLine(Now & " - WARNING: " & KBname & " is already installed; skipping installation.")
Case -2145124329
LogFile.WriteLine(Now & " - WARNING: " & KBname & " is not required for this system; skipping installation.")
Case Else
LogFile.WriteLine(Now & " - Install of " & KBname & " has completed with return code: " & RETURN)
End Select
End Function

If is error code 800A03F6 it could mean an error related to an If-Then elsewhere (prior to this function) that wasn't properly closed.

Related

using VB6 executing a batch passing two arguments, two variables seperated by a space

I am attempting to execute a batch file with two arguments from vb6.
Shell ("c:\tftp\Createplkstart.txt.bat " & strMsg & " " & cfgSaved & switchIP)
however it seems to drop the second and third arguments.
If I do a msgbox :
MsgBox "\c:\tftp\Createplkstart.txt.bat " & strstart & " " & cfgSaved
it returns two lines with the space " ".
thanks for any advice

Re-raise error if wrong type

I'm looking for a specific database error when doing a query. If the error is not found then I would like standard error handling to be used.
On Error Resume Next
db.execute(strSQL)
If db.Errors.Count > 0 Then
If InStr(db.Errors(0).Description, "IX_Code") Then
...
Else
* rethrow here *
End If
End If
Is this possible?
I tried...
On Error GoTo 0
Err.Raise 22, "Big Error", "Hello World!"
But nothing happens.
I added this code, which I found here...
For Each errLoop In db.Errors
strError = "Error #" & errLoop.Number & "<br>" & _
" " & errLoop.Description & "<br>" & _
" (Source: " & errLoop.Source & ")" & "<br>" & _
" (SQL State: " & errLoop.SQLState & ")" & "<br>" & _
" (NativeError: " & errLoop.NativeError & ")" & "<br>"
Response.Clear
Response.Write("<p>" & strError & "</p>")
Response.End
Next

How to apply a VBA macro to all files in a directory?

I have a sub-directory with ~1000 Word Documents I'd like to apply the following macro to style hyperlinks to each of them, but I can't really open each of them to run the script. Is there any way I can set it to apply to every document in the directory? Could I call it from a bash script?
Sub FormatLinks()
Dim H As Hyperlink
For Each H In ActiveDocument.Hyperlinks
H.Range.Select ' (A)
Selection.ClearFormatting ' (B)
H.Range.Style = ActiveDocument.Styles("Hyperlink") ' (C)
Next H
End Sub
This is from Filter, a program that filters stdin to stdout. This part here is from run a command line specifed script on each line in a file. Dir /b gives you a list of files.
Set Arg = WScript.Arguments
set WshShell = createObject("Wscript.Shell")
Set Inp = WScript.Stdin
Set Outp = Wscript.Stdout
RawScript = Arg(1)
'Remove ^ from quoting command line and replace : with vbcrlf so get line number if error
Script = Replace(RawScript, "^", "")
Script = Replace(Script, "'", chr(34))
Script = Replace(Script, ":", vbcrlf)
'Building the script with predefined statements and the user's code
Script = "Dim gU" & vbcrlf & "Dim gdU" & vbcrlf & "Set gdU = CreateObject(" & chr(34) & "Scripting.Dictionary" & chr(34) & ")" & vbcrlf & "Function UF(L, LC)" & vbcrlf & "Set greU = New RegExp" & vbcrlf & "On Error Resume Next" & vbcrlf & Script & vbcrlf & "End Function" & vbcrlf
'Testing the script for syntax errors
On Error Resume Next
set ScriptControl1 = wscript.createObject("MSScriptControl.ScriptControl",SC)
With ScriptControl1
.Language = "VBScript"
.UseSafeSubset = False
.AllowUI = True
.AddCode Script
End With
With ScriptControl1.Error
If .number <> 0 then
Outp.WriteBlankLines(1)
Outp.WriteLine "User function syntax error"
Outp.WriteLine "=========================="
Outp.WriteBlankLines(1)
Outp.Write NumberScript(Script)
Outp.WriteBlankLines(2)
Outp.WriteLine "Error " & .number & " " & .description
Outp.WriteLine "Line " & .line & " " & "Col " & .column
Exit Sub
End If
End With
ExecuteGlobal(Script)
'Remove the first line as the parameters are the first line
'Line=Inp.readline
Do Until Inp.AtEndOfStream
Line=Inp.readline
LineCount = Inp.Line
temp = UF(Line, LineCount)
If err.number <> 0 then
outp.writeline ""
outp.writeline ""
outp.writeline "User function runtime error"
outp.writeline "==========================="
Outp.WriteBlankLines(1)
Outp.Write NumberScript(Script)
Outp.WriteBlankLines(2)
Outp.WriteLine "Error " & err.number & " " & err.description
Outp.WriteLine "Source " & err.source
Outp.WriteLine "Line number and column not available for runtime errors"
wscript.quit
End If
outp.writeline temp
Loop
General Use
filter <inputfile >outputfile
filter <inputfile | other_command
other_command | filter >outputfile
other_command | filter | other_command
Vbs
filter vbs "text of a vbs script"
filter vb "text of a vbs script"
Use colons to seperate statements and lines. Use single quotes in place of double quotes, if you need a single quote use chr(39). Escape brackets and ampersand with the ^ character. If you need a caret use chr(136).
The function is called UF (for UserFunction). It has two parameters, L which contains the current line and LC which contains the linecount. Set the results of the script to UF. See example.
There are three global objects available. An undeclared global variable gU to maintain state. Use it as an array if you need more than one variable. A Dictionary object gdU for saving and accessing previous lines. And a RegExp object greU ready for use.
Example
This vbs script inserts the line number and sets the line to the function UF which Filter prints.
filter vbs "uf=LC ^& ' ' ^& L"<"%systemroot%\win.ini"
This is how it looks in memory
Dim gU
Set gdU = CreateObject("Scripting.Dictionary")
Set greU = New RegExp
Function UF(L, LC)
---from command line---
uf=LC & " " & L
---end from command line---
End Function
If there is a syntax error Filter will display debugging details.
User function syntax error
1 Dim gU
2 Dim gdU
3 Set greU = CreateObject("Scripting.Dictionary")
4 Function UF(L, LC)
5 On Error Resume Next
6 uf=LC dim & " " & L
7 End Function
Error 1025 Expected end of statement
Line 6 Col 6
User function runtime error
1 Dim gU
2 Dim gdU
3 Set greU = CreateObject("Scripting.Dictionary")
4 Function UF(L, LC)
5 On Error Resume Next
6 uf=LC/0 & " " & L
7 End Function
Error 11 Division by zero
Source Microsoft VBScript runtime error
Line number and column not available for runtime errors
Other examples
Reverse each line
filter vbs "uf=StrReverse^(L^)"<"%systemroot%\win.ini"

How can we programmatically know the syntax error using msscript.ocx?

I have implemented msscript.ocx using c# and it works for VBScript.
Consider the following VBScript code:
For i = 0 To 5
'The following line has missing 'Then'. It should show an error.
If i = 2
Exit For
End If
Next
How can we tell if there is an error in line containing If (missing Then) without running the script?
You get the error when loading.
Set Arg = WScript.Arguments
set WshShell = createObject("Wscript.Shell")
Set Inp = WScript.Stdin
Set Outp = Wscript.Stdout
Sub VBSCmd
RawScript = Arg(1)
'Remove ^ from quoting command line and replace : with vbcrlf so get line number if error
Script = Replace(RawScript, "^", "")
Script = Replace(Script, "'", chr(34))
Script = Replace(Script, ":", vbcrlf)
'Building the script with predefined statements and the user's code
Script = "Dim gU" & vbcrlf & "Dim gdU" & vbcrlf & "Set gdU = CreateObject(" & chr(34) & "Scripting.Dictionary" & chr(34) & ")" & vbcrlf & "Function UF(L, LC)" & vbcrlf & "Set greU = New RegExp" & vbcrlf & "On Error Resume Next" & vbcrlf & Script & vbcrlf & "End Function" & vbcrlf
'Testing the script for syntax errors
On Error Resume Next
set ScriptControl1 = wscript.createObject("MSScriptControl.ScriptControl",SC)
With ScriptControl1
.Language = "VBScript"
.UseSafeSubset = False
.AllowUI = True
.AddCode Script
End With
With ScriptControl1.Error
If .number <> 0 then
Outp.WriteBlankLines(1)
Outp.WriteLine "User function syntax error"
Outp.WriteLine "=========================="
Outp.WriteBlankLines(1)
Outp.Write NumberScript(Script)
Outp.WriteBlankLines(2)
Outp.WriteLine "Error " & .number & " " & .description
Outp.WriteLine "Line " & .line & " " & "Col " & .column
Exit Sub
End If
End With
ExecuteGlobal(Script)
'Remove the first line as the parameters are the first line
'Line=Inp.readline
Do Until Inp.AtEndOfStream
Line=Inp.readline
LineCount = Inp.Line
temp = UF(Line, LineCount)
If err.number <> 0 then
outp.writeline ""
outp.writeline ""
outp.writeline "User function runtime error"
outp.writeline "==========================="
Outp.WriteBlankLines(1)
Outp.Write NumberScript(Script)
Outp.WriteBlankLines(2)
Outp.WriteLine "Error " & err.number & " " & err.description
Outp.WriteLine "Source " & err.source
Outp.WriteLine "Line number and column not available for runtime errors"
wscript.quit
End If
outp.writeline temp
Loop
End Sub
Vbs
filter vbs "text of a vbs script"
Use colons to seperate statements and lines. Use single quotes in place of double quotes, if you need a single quote use chr(39). Escape brackets and ampersand with the ^ character. If you need a caret use chr(136).
The function is called UF (for UserFunction). It has two parameters, L which contains the current line and LC which contains the linecount. Set the results of the script to UF. See example.
There are three global objects available. An undeclared global variable gU to maintain state. Use it as an array if you need more than one variable. A Dictionary object gdU for saving and accessing previous lines. And a RegExp object greU ready for use.
Example
This vbs script inserts the line number and sets the line to the function UF which Filter prints.
filter vbs "uf=LC ^& ' ' ^& L"<"%systemroot%\win.ini"
This is how it looks in memory
Dim gU
Set gdU = CreateObject("Scripting.Dictionary")
Set greU = New RegExp
Function UF(L, LC)
---from command line---
uf=LC & " " & L
---end from command line---
End Function
If there is a syntax error Filter will display debugging details.

VBscript Robocopy Syntax

I am having a problem with what I think is a syntax error in VBscript regarding running robocopy.
The following is a code snippet of what I now using to try to run robocopy:
Dim Command2
sLocalDestinationPath = "C:\Script\files\outzips\"
sFinalDestinationPath = "C:\CopyTestFolder\"
Command2 = "Robocopy.exe " & sLocalDestinationPath & " " & sFinalDestinationPath
The thing is that the command does not produce any errors, but it also does not copy any files from the local path to the final path. It runs perfectly fine when executed from the command line. Any help would be greatly appreciated because this simple command is keeping me from finishing the rest of this script.
I also have it echoing out the command and the command matches exactly what I put in the command line.
Thank you, if you need anymore explanation just let me know.
You don't say how you are trying to 'run' Robocopy, but I presume it is via WScript.Shell.Run().
I don't happen to have Robocopy handy, but I did work up an example using Windows XCopy. Perhaps you can adapt my simple XCopy example to gain more insight into your problem with Robocopy.
Option Explicit
' XCOPY doesn't Like trailing slashes in folder names
Const sLocalDestinationPath = "C:\Script\files\outzips"
Const sFinalDestinationPath = "C:\CopyTestFolder"
Dim Command2 : Command2 = _
"XCOPY" _
& " " & sLocalDestinationPath _
& " " & sFinalDestinationPath _
& " /E /I /Y" _
& ""
Dim oSh : Set oSh = CreateObject("WScript.Shell")
WScript.Echo "Cmd: [" & Command2 & "]"
On Error Resume Next
Dim nRetVal : nRetval = oSh.Run(Command2, 0, True)
If Err Then
WScript.Echo "An exception occurred:" _
& vbNewLine & "Number: [" & Hex(Err.Number) & "]" _
& vbNewLine & "Description: [" & Err.Description & "]" _
& ""
Else
If nRetVal Then
WScript.Echo "Copy error: [" & nRetVal & "]"
Else
WScript.Echo "Copy succeeded."
End If
End If
Set oSh = Nothing
' XCOPY options:
'
' /E Copies directories and subdirectories, including empty ones.
' Same as /S /E. May be used to modify /T.
'
' /I If destination does not exist and copying more than one file,
' assumes that destination must be a directory.
'
' /Y Suppresses prompting to confirm you want to overwrite an
' existing destination file.
' End

Resources