in vbscript an Error when using Regexp.Execute - vbscript

In vbscript while using regular expression EXECUTE function, when there is a match the program proceeds, but when there is no match than the program throws an error and crashes. Is there a way of fixing this, a workaround ? Thanks in advance.
dim object_str : object_str = "cup of tea"
Set compare_exp = new RegExp
compare_exp.IgnoreCase = False
compare_exp.Global = True
compare_exp.Pattern = "tea1"
wscript.echo compare_exp.Execute(object_str).Item(0).Value
wscript.echo "continue"

Make sure the regex found a match before attempting to read the results:
dim object_str : object_str = "cup of tea"
Set compare_exp = new RegExp
compare_exp.IgnoreCase = False
compare_exp.Global = True
compare_exp.Pattern = "tea1"
dim result: set result = compare_exp.Execute(object_str)
if result.count > 0 then
wscript.echo result.Item(0).Value
else
wscript.echo "no match"
end if

Related

vbscript to check if a window is open using wildcard

I would like to check if a window is open using wildcard in vbscript. I was able to find the code below:
Set oShell = CreateObject("WScript.Shell")
If oShell.AppActivate("Untitled - Notepad") Then
WScript.Sleep 500
End If
But i would like to use a wildcard on the window title. I tried using * and % but it's not working. Any help is appreciated.
If oShell.AppActivate("*Notepad*") Then
Updates guys.. I was able to find a solution but it is still open if someone can simplify this. Thank you.
Set Word = CreateObject("Word.Application")
Set Tasks = Word.Tasks
isFound = False
For i = 1 to 5
For Each Task in Tasks
checkVal = 0
If Task.Visible Then
checkVal = inStr(UCase(Task.name), UCase("outlook"))
If checkVal <> 0 Then
isFound = True
Exit For
End If
End If
Next
If isFound = True Then
Exit For
End If
WScript.Sleep 1000
Next
Word.Quit
msgbox ("Is the Window Found? - " & isFound)
Check out this method versus creating a word doc. That method requires a dependency of having office installed. This uses only native Windows libraries.
First function: findwindowtitle
Executes the Tasklist command to enumerate and filter down the list of titles. Then fires off the regex parser to match your string against the leftover values from tasklist.
Second function: matchtitle Then it proceeds to use convert your wildcard into a regular expression of the [a-zA-Z0-9.- ] which is alphanumeric including spaces. Kind of required for the wildcard and allowed characters for windows files to work.
MysearchString = "*Notepad"
processtitle = findwindowtitle(MysearchString)
wscript.echo "My search found window title: '" & processtitle & "'"
'do something with processtitle
function findwindowtitle(srchstr)
filtersrchstr = replace(srchstr, "*", "")
strcommand = "tasklist /v | find /i """ & filtersrchstr & """"
cmdout = CreateObject("Wscript.Shell").Exec("cmd /c """ & strcommand & " 2>&1 """).stdout.readall
wscript.sleep 500
findwindowtitle = matchtitle(srchstr, cmdout)
End Function
Function matchtitle(srchstr, input)
matchtitle = false
if instr(1, srchstr, "*", 1) <> 0 Then
filtersrchstr = replace(srchstr, "*", "")
filterstrpatt = replace(srchstr, "*", "[a-zA-Z0-9\.- ]*")
end if
Set regex = CreateObject("VBScript.RegExp")
regex.MultiLine = True
regex.Global = True
regex.IgnoreCase = True
regex.Pattern = "(?:.*)(?:\d\d?\d?:\d\d:\d\d\s)(\b" & filterstrpatt & "\b)"
Set matches = regex.Execute(input)
for m = 0 to matches.count - 1
Set SubMatches = matches.item(m).SubMatches
for i = 0 to (Submatches.count - 1)
if instr(1, Submatches.item(i), filtersrchstr, 1) <> 0 then matchtitle = Submatches.item(i)
Next
Next
if (matchtitle = false) then
wscript.echo "Could not find process with title matching, '" & srchstr & "'"
wscript.quit
end if
End Function

VBScript Replace specific value with regex and modify text file

I know there are a lot questions similar to this one but i couldn't find the right answer for me. I need to replace all phrases in xml file that starts and ends with % (e.g. %TEST% or %TEST-NEW% )
So far i have these tryouts:
This was my test one that works in the console but has only 1 line of string
zone = "<test>%TEST%</test>"
MsgBox zone
'Setting the regex and cheking the matches
set regex = New RegExp
regex.IgnoreCase = True
regex.Global = True
regex.Pattern = "%.+%"
Set myMatches = regex.execute(zone)
For each myMatch in myMatches
Wscript.echo myMatch
result = Replace(zone,myMatch,"")
next
MsgBox result
but when i try to do the same from a file with this...
Dim objStream, strData, fields
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Open
objStream.LoadFromFile("C:\test\test.xml")
strData = objStream.ReadText()
Wscript.echo strData
set regex = New RegExp
regex.IgnoreCase = True
regex.Global = True
regex.Pattern = "%.+%"
Set myMatches = regex.execute(strData)
For each myMatch in myMatches
Wscript.echo myMatch
result = Replace(strData,myMatch,"")
next
Wscript.echo result
...the first echo returns correctly the contains of the file and then the second echo in the loop echoes all the matches that i need to replace , but the last echo return the same result as the first (nothing is being replaced)
The xml looks like this (just for example):
<script>%TEST%</script>
<value>%VALUE%</value>
<test>%TEST%</test>
P.S. I need to loop through xml files in a specific folder and replace the phrase from above. Can anyone help?
The final script that works for me(big thanks to Tomalak):
Option Explicit
Dim path, doc, node, placeholder,srcFolder,FSO,FLD,fil
Set placeholder = New RegExp
placeholder.Pattern = "%[^%]+%"
placeholder.Global = True
srcFolder = "C:\test"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLD = FSO.GetFolder(srcFolder)
For each fil In FLD.Files
if LCase(FSO.GetExtensionName(fil.Name)) = "xml" Then
path = "C:\test\" & fil.Name
' 1. parse the XML into a DOM
Set doc = LoadXmlDoc(path)
' 2. select and modify DOM nodes
For Each node In doc.selectNodes("//text()|//#*")
node.nodeValue = SubstitutePlaceholders(node.nodeValue)
Next
' 3. save modified DOM back to file
doc.save path
End If
Next
' --------------------------------------------------------------------------
Function LoadXmlDoc(path)
Set LoadXmlDoc = CreateObject("MSXML2.DomDocument.6.0")
LoadXmlDoc.async = False
LoadXmlDoc.load path
If LoadXmlDoc.parseError.errorCode <> 0 Then
WScript.Echo "Error in XML file."
WScript.Echo LoadXmlDoc.parseError.reason
WScript.Quit 1
End If
End Function
' --------------------------------------------------------------------------
Function SubstitutePlaceholders(text)
Dim match
For Each match In placeholder.Execute(text)
text = Replace(text, match, GetReplacement(match))
Next
SubstitutePlaceholders = text
End Function
' --------------------------------------------------------------------------
Function GetReplacement(placeholder)
Select Case placeholder
Case "%TEST%": GetReplacement = "new value"
Case "%BLA%": GetReplacement = "other new value"
Case Else: GetReplacement = placeholder
End Select
End Function
' --------------------------------------------------------------------------
Never use regular expressions on XML files, period.
Use an XML parser. It will be simpler, the code will be easier to read, and most importantly: It will not break the XML.
Here is how to modify your XML document in the proper way.
Option Explicit
Dim path, doc, node, placeholder
Set placeholder = New RegExp
placeholder.Pattern = "%[^%]+%"
placeholder.Global = True
path = "C:\path\to\your.xml"
' 1. parse the XML into a DOM
Set doc = LoadXmlDoc(path)
' 2. select and modify DOM nodes
For Each node In doc.selectNodes("//text()|//#*")
node.nodeValue = SubstitutePlaceholders(node.nodeValue)
Next
' 3. save modified DOM back to file
doc.save path
' --------------------------------------------------------------------------
Function LoadXmlDoc(path)
Set LoadXmlDoc = CreateObject("MSXML2.DomDocument.6.0")
LoadXmlDoc.async = False
LoadXmlDoc.load path
If LoadXmlDoc.parseError.errorCode <> 0 Then
WScript.Echo "Error in XML file."
WScript.Echo LoadXmlDoc.parseError.reason
WScript.Quit 1
End If
End Function
' --------------------------------------------------------------------------
Function SubstitutePlaceholders(text)
Dim match
For Each match In placeholder.Execute(text)
text = Replace(text, match, GetReplacement(match))
Next
SubstitutePlaceholders = text
End Function
' --------------------------------------------------------------------------
Function GetReplacement(placeholder)
Select Case placeholder
Case "%TEST%": GetReplacement = "new value"
Case "%BLA%": GetReplacement = "other new value"
Case Else: GetReplacement = placeholder
End Select
End Function
' --------------------------------------------------------------------------
The XPath expression //text()|//#* targets all text nodes and all attribute nodes. Use a different XPath expression if necessary. (I will not cover XPath basics here, there are plenty of resources for learning it.)
Of course this solution uses regular expressions, but it does that on the text values that the XML structure contains, not on the XML structure itself. That's a crucial difference.

how to make sure that all textbox are filled before saving in VB 6.0

I'm new to vb and trying to figure things out via searching the net or asking colleagues but now I hit a dead end. I want to have my program to make sure that all my textboxes are filled before saving into the db.
Here is my code:
Private Sub CmdSave_Click()
Set rs = New ADODB.Recordset
With rs
.Open "Select * from table1", cn, 2, 3
If LblAdd_Edit.Caption = "ADD" Then
If MsgBox("Do you want to save this new rocord?", vbQuestion + vbYesNo, "FJD Inventory") = vbNo Then: Exit Sub
.AddNew
!Type = TxtName.Text
!System = txtsys.Text
!acc = TxtAcc.Text
!owner = TxtOwn.Text
!dept = TxtDpt.Text
!svctag = txtSvcTag.Text
.Update
Else
If MsgBox("Do you want to save this changes?", vbQuestion + vbYesNo, "FJD Inventory") = vbNo Then: Exit Sub
Do While Not .EOF
If LvList.SelectedItem.Text = !Type Then
!Type = TxtName.Text
!System = txtsys.Text
!acc = TxtAcc.Text
!owner = TxtOwn.Text
!dept = TxtDpt.Text
!svctag = txtSvcTag.Text
.Update
Exit Do
Else
.MoveNext
End If
Loop
End If
End With
Form_Activate
Save_Cancel
End Sub
I was trying to add the following
If TxtName.Text = "" Or txtsys.Text = "" Or TxtAcc.Text = "" Or TxtOwn.Text = "" Or TxtDpt.Text = "" Or txtSvcTag.Text = "" Then
MsgBox("All Fields Required", vbCritical, "Error") = vbOK: Exit Sub
When I run the program I get a compile error
function or call on the left-hand side of assignment must return a variant or object. I use that msgbox function all the time but now its the line I get an error
If TxtName.Text = "" Or txtsys.Text = "" Or TxtAcc.Text = "" Or TxtOwn.Text = "" Or TxtDpt.Text = "" Or txtSvcTag.Text = "" Then
If MsgBox("All Fields Required", vbCritical, "Error") = vbOK Then Exit Sub
Here is a generic solution. It uses a function to check each textbox on the form and demonstrates using the function. I also compare the text length rather than the text to an empty string because (in general) numeric comparisons are faster than string comparisons.
Private Sub Command1_Click()
If ValidateTextFields Then
MsgBox "Your changes have been saved."
Else
MsgBox "All fields are required."
End If
End Sub
Private Function ValidateTextFields() As Boolean
Dim ctrl As Control
Dim result As Boolean
result = True 'set this to false if a textbox fails
For Each ctrl In Me.Controls
If TypeOf ctrl Is TextBox Then
If Len(ctrl.Text) = 0 Then
result = False
Exit For 'bail on the first failure
End If
End If
Next ctrl
ValidateTextFields = result
End Function
In VB6, you can use Trim() function so that spaces not considered as characters.
If (Trim$(txtGOSID.Text) = "") Then
msgBox "Please provide input.", vbExclamation
With the $ sign, Trim() returns a String value directly; without the $
sign, Trim() returns a Variant with a sub-type of String.

Remove parts of a string and copy the rest back to a file with vbscript

I would like to remove the unwanted text from each string in a file.
the input string looks like this
username^time stamp^don't need this printed on printer name more useless info pages printed:some number
I want to remove everything else but keep the username,time stamp,printer name and some number.Then write each line to a file so the output looks like this
username timestamp printername some number
This is the code I'm working with
Set fs = CreateObject("Scripting.FileSystemObject")
sf = "C:\test.txt"
Set f = fs.OpenTextFile(sf, 1) ''1=for reading
s = f.ReadAll
segments = Split(s,"^",-1)
s= segments(1,)
f.Close
Set f = fs.OpenTextFile(sf, 2) ''2=ForWriting
f.Write s
f.Close
There's always a moment that somebody asks "Why not use a regular expression?". This is that moment.
Try this:
Dim re, s, match, matches
s = "Chuck Norris^12-12-2012^don't need this printed on HAL9000 more useless info pages printed:42 "
Set re = new regexp
re.pattern = "(.*)\^(.*)\^.*printed on (\w+).*pages printed:(\d+).*"
re.Global = True
Set matches = re.Execute(s)
Set match = matches(0)
msgbox "username=" & match.submatches(0)
msgbox "time stamp=" & match.submatches(1)
msgbox "printer=" & match.submatches(2)
msgbox "pages printed=" & match.submatches(3)
Neat huh? And I bet you'll figure out how to implement it in your existing code.
Code:
Const csSep = "^"
'username^time^(other arbitrary junk)^printer name^(other arbitrary junk)^page count
Dim sJunk : sJunk = "kurt^01:02:03^some junk^nec p7^nix^123"
WScript.Echo sJunk
Dim aParts : aParts = Split(sJunk, csSep)
Dim sNetto : sNetto = Join(Array(aParts(0),aParts(1),aParts(3),aParts(5)), csSep)
WScript.Echo sNetto
output:
kurt^01:02:03^some junk^nec p7^nix^123
kurt^01:02:03^nec p7^123

Using VB6, how can I check whether a sub-string is at the beginning of a another string?

I need to go through a text file and check whether the start of each line begins with "Attribute". How should I do this in VB6?
Use a Regex. You will have to include the VBScript Regular Expressions library in your references.
Dim reg As new Scripting.Regex().
reg.Pattern = "^Attribute"
If reg.Match(line) Then
' Do Something
End If
Dim sInput As String, check as Boolean
check = true
Open "myfile" For INPUT As #txtFile
While Not EOF(txtFile)
Input #txtFile, sInput
If Not Mid(sInput,1,9) = "ATTRIBUTE" Then
check = false
End if
sInput = ""
Wend
Close #txtFile
If check = true at the end, all lines start with "ATTRIBUTE", otherwise they do not.
You could try something like this (code not tested) -
Dim ParseDate, AllLinesStartWithAttribute, fso, fs
AllLinesStartWithAttribute = False
Set fso = CreateObject("Scripting.FileSystemObject")
Set fs = fso.OpenTextFile("c:\yourfile", 1, True)
Do Until fs.AtEndOfStream
If Left(fs.ReadLine, 9) <> "Attribute" Then
AllLinesStartWithAttribute = False
Exit Do
End If
Loop
fs.Close
Set fs = Nothing
Once the code is run if the AllLinesStartWithAttribute value is set to true then all lines in your file begin with 'Attribute'. Please note that this code is case sensitive.
Dim fso As New FileSystemObject
Dim ts As TextStream
Dim str As String
Set ts = fso.OpenTextFile(MyFile)
Do While Not ts.AtEndOfStream
str = ts.ReadLine
If InStr(str, "Attribute") = 1 Then
' do stuff
End If
Loop

Resources