I have a text file that I want to read. It looks like this
Error: Deadlock
Param 0 = xyx
Param 1 = 22332244
Param 2 =
Param 3 = 1
Param 4 =
I need to search for String "Deadlock" and spit out output for Param 0 and Param 1. Right now I am able only able to read line that contains text deadlock :(
Const ForReading = 1
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "deadlock"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\1\Retrieve.log", ForReading)
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch in colMatches
Wscript.Echo strSearchString
Next
End If
Loop
objFile.Close
Marc B's idea in simple code:
Option Explicit
Function qq(sTxt) : qq = """" & sTxt & """" : End Function
Const csFind = "Error: Deadlock"
Dim nLines : nLines = 3
Dim bFound : bFound = False
Dim tsIn : Set tsIn = CreateObject("Scripting.FileSystemObject").OpenTextFile("..\data\Text-1.txt")
Do Until tsIn.AtEndOfStream
Dim sLine : sLine = tsIn.ReadLine()
If bFound Then
WScript.Echo sLine, "=>", qq(Trim(Split(sLine, "=")(1)))
nLines = nLines - 1
If 0 = nLines Then Exit Do
Else
bFound = sLine = csFind
End If
Loop
tsIn.Close
Output:
type ..\data\Text-1.txt
Error: Deadlock
Param 0 = xyx
Param 1 = 22332244
Param 2 =
Param 3 = 1
Param 4 =
Error: This is no Deadlock
Param 0 = abc
Param 1 = def
Param 2 =
Param 3 = ghi
Param 4 =
DNV35 E:\trials\SoTrials\answers\9812373\vbs
cscript 00.vbs
Param 0 = xyx => "xyx"
Param 1 = 22332244 => "22332244"
Param 2 = => ""
"simple" means "exactly what is needed to solve the problem - no more, no less".
A decent script needs "Option Explicit" to guard against typos in
variable names.
If you don't use the create and format parameters of the .OpenTextFile method, you don't need the iomode parameter ForReading (it's the default).
If you search for constant/fixed strings, RegExps are just an error prone overhead.
If you want to match "Deadlock" using the pattern "deadlock", you need .IgnoreCase (proves 3)
If you don't want to match "Error: This is no Deadlock", you need a more elaborate pattern (proves 3 again)
There in no need for the objFSO variable, if you use the object just once; same holds for strSearchString (why emphasize 'string' twice but hode the 'search in' vs. 'search for' difference?)
In your case, .Count is either 0 or 1 - I assume the there are no lines like "Error: Deadlock 1, Deadlock 2, and another deadlock"; to deal with more than one match, you'd have to specify .Global.
Looping over the matches collection makes no sense for your problem - either you got the triggering "deadlock" line or not.
A script to search for a triggering line and then do something needs at least one state (bFound and nLines in this case) to do different actions for the lines depending on properties of lines seen before and now long forgotten.
After the 'something' there is no need to process the file further.
Related
I am trying to pass folder location as variable to a VBScript which has array to consume the location as a parameter. I don't know how to pass it, could some one please help me?
I am trying to pass following location as a variable "C:\New","C:\New1" to the below code, the script is working fine when I directly give the location, but when I tired to pass it as variable it is not working.
Code given below:
Set oParameters = WScript.Arguments
folderlocation = oParameters(0)
Dim folderarray
Dim WshShell, oExec
Dim wow()
Set objShell = CreateObject("WScript.Shell")
Dim oAPI, oBag
Dim fso, folder, file
Dim searchFileName, renameFileTo, day
Dim i
folderarray = Array(folderlocation)
ii = 0
day = WeekDay(Now())
If day = 3 Then
aa = UBound(folderarray)
f = 0
j = 0
x = 0
Y = 0
For i = 0 To aa
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderarray(i))
For Each file In folder.Files
If InStr(file.Name, name) = 1 Then
ii = 1
strid = file.Name
Set re = New RegExp
re.Pattern = ".*myfile.*"
If re.Test( strid ) Then
'msgbox "File exist and the file name is """ & strid & """"
x = x+1
Else
'msgbox "file not found"
End If
Set re = Nothing
End If
Next
If x = 0 Then
ReDim Preserve wow(f)
wow(f) = folderarray(i)
f = f+1
j = j+1
Else
x = 0
End If
Next
End If
If J > 0 Then
ReDim Preserve wow(f-1)
value = Join(wow, ",")
MsgBox "Files not found in the following location(s) :" & value
Else
MsgBox "fine"
End If
To fill an array from a list of arguments you'd call the script like this:
your.vbs "C:\New" "C:\New1"
and fill the array in your.vbs like this:
size = WScript.Arguments.Unnamed.Count - 1
ReDim folderarray(size)
For i = 0 To size
folderarray(i) = WScript.Arguments.Unnamed.Item(i)
Next
If for some reason you must pass the folder list as a single argument you'd call the script like this:
your.vbs "C:\New,C:\New1"
and populate the array in your.vbs like this:
folderarray = Split(WScript.Arguments.Unnamed.Item(0), ",")
I have a problem in that I need to read a specified quantity of characters from a text file, but the specified quantity varies so I cannot use a constant EG:
variable = WhateverIsSpecified
strText = objFile.Read (variable) ' 1 ~ n+1
objOutfile.write strText
NOT
strText = objFile.Read (n) ' n = any constant (interger)
When using the first way, the output is blank (no characters in the output file)
Thanks in advance
UPDATE
These are the main snippets in a bit longer code
Set file1 = fso.OpenTextFile(file)
Do Until file1.AtEndOfStream
line = file1.ReadLine
If (Instr(line,"/_N_") =1) then
line0 = replace(line, "/", "%")
filename = file1.Readline
filename = Left(filename, len(filename)-3) & "arc"
Set objOutFile = fso.CreateTextFile(destfolder & "\" & filename)
For i = 1 to 5
line = file1.Readline
next
nBytes = line 'this line contains the quantity needed to be read eg 1234
Do until Instr(line,"\") > 0
line = file1.ReadLine
Loop
StrData = ObjFile.Read (nBytes)
objOutFile.Write StrData
objOutFile.close
End if
Loop
WScript.quit
My own stupid error,
StrData = ObjFile.Read (nBytes)
should be
StrData = file1.Read (nBytes)
The script below works in finding duplicates.
But most of the files i'm reading follow this format:
ServerName(1) = "Example1"
ServerName(2) = "Example1"
ServerName(3) = "Example3"
ServerName(4) = "Example4"
ServerName(5) = "Example5"
The 'cut' variable in the code below is supposed to cut the string at the "=" delimiter and return the value that comes after the "=" delimeter.
It should write to the duplicate file "Example1" but instead writes nothing. How would I make it so that the script below reads a file and only finds the duplicate in values after the "=" delimeter.
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
FileName = "Test.txt"
PathToSave = "C:"
Path = (PathToSave & FileName)
Set objFile = objFSO.OpenTextFile(Path, ForReading)
Set objOutputFile = objFSO.OpenTextFile(PathToSave & "Noduplicates.txt", 2, True)
Set objOutputFile2 = objFSO.OpenTextFile(PathToSave & "Duplicates.txt", 2, True)
objOutputFile.WriteLine ("This document contains the " & path & " file without duplicates" & vbcrlf)
objOutputFile2.WriteLine ("This document contains the duplicates found. Each line listed below had a duplicate in " & Path & vbcrlf)
Dim DuplicateCount
DuplicateCount = 0
Set Dict = CreateObject("Scripting.Dictionary")
Do until objFile.atEndOfStream
strCurrentLine = LCase(Trim(objFile.ReadLine))
Cut = Split(strCurrentline,"=")
If not Dict.Exists(LCase(Trim(cut(strCurrentLine)))) then
objOutputFile.WriteLine strCurrentLine
Dict.Add strCurrentLine,strCurrentLine
Else Dict.Exists(LCase(Trim(cut(strCurrentLine))))
objOutputFile2.WriteLine strCurrentLine
DuplicateCount = DuplicateCount + 1
End if
Loop
If DuplicateCount > 0 then
wscript.echo ("Number of Duplicates Found: " & DuplicateCount)
Else
wscript.echo "No Duplicates found"
End if
Cut is your array, so Cut(1) is the portion after the =. So that's what you should test for in your dictionary.
If InStr(strCurrentline, "=") > 0 Then
Cut = Split(strCurrentline,"=")
If Not Dict.Exists(Cut(1)) then
objOutputFile.WriteLine strCurrentLine
Dict.Add Cut(1), Cut(1)
Else
objOutputFile2.WriteLine strCurrentLine
DuplicateCount = DuplicateCount + 1
End if
End If
I makes no sense at all to ask Split to return an array with one element by setting the 3rd parameter to 1, as in
Cut = Split(strCurrentline,"=",1)
Evidence:
>> WScript.Echo Join(Split("a=b", "=", 1), "*")
>>
a=b
>> WScript.Echo Join(Split("a=b", "="), "*")
>>
a*b
BTW: ServerName(5) = "Example5" should be splitted on " = "; further thought about the quotes may be advisable.
Update wrt comments (and downvotes):
The semantics of the count parameter according to the docs:
count
Optional. Number of substrings to be returned; -1 indicates that all substrings are returned. If omitted, all substrings are returned.
Asking for one element (not an UBound!) results in one element containing the input.
Evidence wrt the type mismatch error:
>> cut = Split("a=b", "=", 1)
>> WScript.Echo cut
>>
Error Number: 13
Error Description: Type mismatch
>>
So please think twice.
i am trying to execute a vbscript from another vbscript. The think is, i have to pass a dictionary as parameter, but i always get the same error message.
Here is my code so far:
dim objShell
Set objShell = Wscript.CreateObject("WScript.Shell")
dim dicExp
Set dicExp = CreateObject("Scripting.Dictionary")
dic.add 0, 10
objShell.Run "C:\Users\groeschm\Desktop\ODBCAktuell.vbs " & dicString
But i always get this error message:
Error 800A01C2 - Wrong number of arguments of invalid property assignment.
Greetings,
Michael
You cannot pass an object reference to WScript.Shell.Run. See http://msdn.microsoft.com/en-us/library/d5fk67ky(v=vs.84).aspx, it says the command line argument is a string, and nothing else.
You cannot pass a Scripting.Dictionary reference, nor can you encode that reference into the string argument.
It´s as simple as that!
And even if you could, this would be useless because the called VBS does not share the same global scope as the caller code.
You should consider alternatives to Run. You could put the ODBCAktuell.vbs code into a function, and call that instead. Or you consider ExecuteFile or one of the related intrinsics.
(Without knowing what ODBCAktuell.vbs contains, and without knowing what exactly you are trying to accomplish, it is difficult to advise you further than that.)
There is a similar question based on the same brainbug: Create instance for a class(resides in B.vbs) from another .VBS file
The OT's code is messed up. dicString is undefined. It does not throw the error claimed, but an "Object Required", because the dictionary is named dicExp, not dic.
While TheBlastOne is right to state that you can't pass anything except strings via the command line, the wish to communicate other (more complex) types of data is legitimate. Making numbers or dates from command line args is standard procedure. And: wanting to re-use code via some kind of import/using/include mechanism isn't a brainbug but essential for good programming.
A general approach to serialisation (via strings) is JSON, but it's not easy to use it in VBScript (cf).
The starting point(s) for a 'roll your own' approach for simple cases (dictionaries with numbers/scalars/simple strings as keys and values) is trivial:
Stringify:
cscript passdic.vbs
cscript recdic.vbs "1 2 3 4"
1 => 2
3 => 4
passdic.vbs:
Option Explicit
Function d2s(d)
ReDim a(2 * d.Count - 1)
Dim i : i = 0
Dim k
For Each k In d.Keys()
a(i) = k
i = i + 1
a(i) = d(k)
i = i + 1
Next
d2s = Join(a)
End Function
Function qq(s)
qq = """" & s & """"
End Function
Dim d : Set d = CreateObject("Scripting.Dictionary")
d(1) = 2
d(3) = 4
Dim c : c = "cscript recdic.vbs " & qq(d2s(d))
WScript.Echo c
Dim p : Set p = CreateObject("WScript.Shell").Exec(c)
WScript.Echo p.Stdout.ReadAll()
recdic.vbs:
Option Explicit
Function s2d(s)
Set s2d = CreateObject("Scripting.Dictionary")
Dim a : a = Split(s)
Dim i
For i = 0 To UBound(a) Step 2
s2d.Add a(i), a(i + 1)
Next
End Function
Dim d : Set d = s2d(WScript.Arguments(0))
Dim k
For Each k In d.Keys()
WScript.Echo k, "=>", d(k)
Next
Code re-use:
cscript passdic2.vbs
cscript recdic2.vbs
1 => 2
3 => 4
passdic2.vbs
Option Explicit
Function d2s(d)
ReDim a(d.Count - 1)
Dim i : i = 0
Dim k
For Each k In d.Keys()
a(i) = "cd.Add " & k & "," & d(k)
i = i + 1
Next
d2s = "Function cd():Set cd=CreateObject(""Scripting.Dictionary""):" & Join(a, ":") & ":End Function"
End Function
Dim d : Set d = CreateObject("Scripting.Dictionary")
d(1) = 2
d(3) = 4
CreateObject("Scripting.FileSystemObject").CreateTextFile("thedic.inc").Write d2s(d)
Dim c : c = "cscript recdic2.vbs"
WScript.Echo c
Dim p : Set p = CreateObject("WScript.Shell").Exec(c)
WScript.Echo p.Stdout.ReadAll()
thedic.inc
Function cd():Set cd=CreateObject("Scripting.Dictionary"):cd.Add 1,2:cd.Add 3,4:End Function
recdic2.vbs
Option Explicit
ExecuteGlobal CreateObject("Scripting.FileSystemObject").OpenTextFile("thedic.inc").ReadAll()
Dim d : Set d = cd()
Dim k
For Each k In d.Keys()
WScript.Echo k, "=>", d(k)
Next
I'm new to vbscripting and I just received a task that requires me to find 6 files with matching strings in the filename so that I can move these files to a different directory. I am using the regex pattern "\d{8}-\d{6}" to locate all of the strings within the filenames.
How would I go about in doing a search in a directory and checking to see if there are 6 files with matching strings in their filenames so that I can store them into an array and then move the files to another directory?
The script I have written so far:
Set objFS = CreateObject("Scripting.FileSystemObject")
strShareDirectory = "in\"
strDumpStorageDir = "out\"
Set objFolder = objFS.GetFolder(strShareDirectory)
Set colFiles = objFolder.Files
Set re = New RegExp
re.Global = True
re.IgnoreCase = False
re.Pattern = "-\d{8}-\d{6}"
Dim curFile, matchValue
Dim i: i = 0
For Each objFile in colFiles
bMatch = re.Test(objFile.Name)
curFile = objFile.Name
If bMatch Then
ReDim preserve matches(i)
Matches(i) = curFile
i = (i + 1)
For Each objFile1 in colFiles
If objFile1.Name <> objFile.Name Then
For each match in re.Execute(objFile1.Name)
matchValue = match.Value
Exit For
Next
If (Instr(curFile, matchValue) > 0) Then
matchCount = 1
For Each match1 in re.Execute(objFile1.Name)
curFile1 = objFile1.Name
matchValue1 = match1.Value
Exit For
'If Then
Next
'msgbox(curFile1)
End If
End If
Next
End If
Next
Here is what my sample directory that I am working with looks like.
As #KekuSemau's proposal does not address the (sub)problem of grouping the files, dweebles does not give the full story (Why the array? Why the insistence on having a full (sub)set of files?), and the numbers (group of 6, 3/4 parts in a file name) aren't really relevant to the basic task - distribute a set files into folders based on parts of the file name - I claim that the way to solve the task is to get rid of all the array, dictionary, and regexp fancies and to keep it simple:
Before:
tree /A /F ..\data
+---in
| B-2
| B-1
| A-3
| A-2
| B-3
| A-1
|
\---out
Code:
Const csSrc = "..\data\in"
Const csDst = "..\data\out"
Dim f, n, d
For Each f In goFS.GetFolder(csSrc).Files
n = Split(f.Name, "-")
If 1 = UBound(n) Then
d = goFS.BuildPath(csDst, n(1))
If Not goFS.FolderExists(d) Then goFS.CreateFolder d
f.Move goFS.BuildPath(d, f.Name)
End If
Next
After:
tree /A /F ..\data
+---in
\---out
+---3
| A-3
| B-3
|
+---1
| B-1
| A-1
|
\---2
B-2
A-2
P.S.
This problem can be solved using the same approach.
Ah, now I understand.
So: you need all file names that match the pattern IF there are at least 6 files with the same matching sub string. Okay. Then, yes, I understand that you can get strangled up in nested for..next loops. If that happens, I would recommend to put some code into extra functions.
In this solution, I use dictionaries to do some work much easier (every call to 'exists' is another nested iteration over all its elements for example, and every assignment as well).
This example would ignore multiple matches within one file name.
option explicit
dim objFS : dim strShareDirectory : dim strDumpStorageDir : dim objFolder : dim colFiles : dim re : dim objFile
dim dictResults ' dictionary of [filename] -> [matching substring]
dim dictResultsCount ' dictionary of [matching substring] -> [count]
dim dictResultsFinal ' only the valid entries from dictResults
dim keyItem
dim strMatch
set dictResultsFinal = CreateObject("Scripting.Dictionary")
set dictResults = CreateObject("Scripting.Dictionary")
set dictResultsCount = CreateObject("Scripting.Dictionary")
Set objFS = CreateObject("Scripting.FileSystemObject")
strShareDirectory = "in\"
strDumpStorageDir = "out\"
Set objFolder = objFS.GetFolder(strShareDirectory)
Set colFiles = objFolder.Files
Set re = New RegExp
re.Global = True
re.IgnoreCase = False
re.Pattern = "-\d{8}-\d{6}"
Dim curFile, matchValue
Dim i: i = 0
For Each objFile in colFiles
' test if the filename matches the pattern
if re.test(objFile.Name) then
' for now, collect all matches without further checks
strMatch = re.execute(objFile.Name)(0)
dictResults(objFile.Name) = strMatch
' and count
if not dictResultsCount.Exists(strMatch) then
dictResultsCount(strMatch) = 1
else
dictResultsCount(strMatch) = dictResultsCount(strMatch) +1
end if
end if
next
' for testing: output all filenames that match the pattern
msgbox join(dictResults.keys(), vblf)
' now copy only the valid entries into a new dictionary
for each keyItem in dictResults.keys()
if dictResultsCount.Exists( dictResults(keyItem) ) then
if dictResultsCount( dictResults(keyItem) ) >= 6 then
dictResultsFinal(keyItem) = 1
end if
end if
next
' test output the final result
msgbox join(dictResultsFinal.keys(), vblf)
--- my first answer
Well I should probably ask what have you tried but... here's your example ^^.
This should give you enough to start from (I ignored that '6' requirements you mentioned). Ask if you need more explanations.
Option explicit
dim a
a = findFiles("G:\", "\d{8}-\d{6}")
msgbox join(a, vblf)
function findFiles(path, pattern)
dim rx
dim fso
dim fsoFolder
dim fsoFiles
dim results
dim item
set rx = new regexp
rx.pattern = pattern
set results = CreateObject("Scripting.Dictionary")
set fso = CreateObject("Scripting.FileSystemObject")
set fsoFolder = fso.GetFolder(path)
set fsoFiles = fsoFolder.Files
for each item in fsoFiles
if rx.test(item.name) then results(item.name) = 1
next
set fso = nothing
set fsoFolder = nothing
set fsoFiles = nothing
findFiles = results.keys()
end function