I have a small VB script (see below) which i found via google, what it does is find a this string (H*699557/1A) in an XML file and renames the filename to that string, This works brilliantly until it encounters a special character (As in the string example) where it then stops.
Could someone please help me to remove the special characters, any help appreciated.
Set objFS = CreateObject("Scripting.FileSystemObject")
strFolder = "C:\vbs"
Set objFolder = objFS.GetFolder(strFolder)
Set regEx = New RegExp
regEx.Pattern = ".*<SuppliersInvoiceNumber>(.*?)</SuppliersInvoiceNumber>.*"
regEx.IgnoreCase = True
regEx.MultiLine = True
For Each strFile In objFolder.Files
strFileName = strFile.Name
If InStr(strFileName ,"USI") > 0 Then
Set objFile=objFS.OpenTextFile(strFileName)
strData = objFile.ReadAll
Set objFile=Nothing
Set colMatches = regEx.Execute(strData)
For Each objMatch In colMatches
strNew = Split(objMatch.Submatches(0),"\")
strNewFile = strNew(0)
strFile.Name = strNewFile & ".xml"
Next
End If
Next
Set objFS = CreateObject("Scripting.FileSystemObject")
strFolder = "C:\vbs"
Set objFolder = objFS.GetFolder(strFolder)
Set regEx = New RegExp
regEx.Pattern = ".*<SuppliersInvoiceNumber>(.*?)</SuppliersInvoiceNumber>.*"
regEx.IgnoreCase = True
regEx.MultiLine = True
For Each strFile In objFolder.Files
strFileName = strFile.Name
If InStr(strFileName ,"USI") > 0 Then
Set objFile=objFS.OpenTextFile(strFileName)
strData = objFile.ReadAll
Set objFile=Nothing
Set colMatches = regEx.Execute(strData)
For Each objMatch In colMatches
strNew = Split(objMatch.Submatches(0),"\")
strNewFile = strNew(0)
strFile.Name = Replace(Replace(strNewFile,"*",""),"/","") & ".xml"
Next
End If
Next
Related
The below .TXT file is read into a VBS FileSystemObject. I am trying to search for all dates that match otherwise I need to put them in a "error.txt" file. However, when I run my code below it is always placing the matches in the error.txt file and not skipping the matching dates.
Why are the dates not matching?
INPUT:
"LIRRR 1M",.412900,02/08/2016
"LIRRR 3M",.222700,02/08/2016
"LIRRR 6M",.333200,02/08/2016
"LIRRR12M",1.1333300,02/08/2016
"FEDFRRRR",.333000,02/08/2016
"CCC 1YR",.550330,02/08/2016
"5YRCMT",1.2503300,02/08/2016
"10YRCMT",1.860000,02/08/2016
Here is the code that I have written:
On error resume next
Const ForReading = 1
Dim strSearchFor
Dim MyDate, MyWeekDay
MyDate = Date ' Assign a date.
MyWeekDay = Weekday(MyDate)
If MyWeekDay = 2 then
strSearchFor =Right("0" & DatePart("m",Date), 2)&"/"&Right("0" & DatePart("d",Date-3), 2)&"/"&DatePart("yyyy",Date)
Else
strSearchFor =Right("0" & DatePart("m",Date), 2)&"/"&Right("0" & DatePart("d",Date-1), 2)&"/"&DatePart("yyyy",Date)
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("C:\Users\Desktop\index.txt", ForReading)
do until objTextFile.AtEndOfStream
strLine = objTextFile.ReadLine()
If InStr(strLine, strSearchFor) <> 0 then
Set objFile = objFSO.CreateTextFile("C:\Users\Desktop\pass.txt")
objFile.Write "date is match"& vbCrLf
Else
Set objFile = objFSO.CreateTextFile("C:\Users\Desktop\error.txt")
objFile.Write "date is not match"& vbCrLf
End If
loop
objTextFile.Close
Why not use RegEx to get the portion of the string that appears to be the date and use the IsDate Function to validate it?
Option Explicit
Dim arrLines,i
arrLines = ReadFile("./input.txt","byline")
For i=LBound(arrLines) to UBound(arrLines)
wscript.echo FormatOutput(arrLines(i))
Next
'*********************************************
Function FormatOutput(s)
Dim re, match
Set re = New RegExp
re.Pattern = "[\d]+[\/-][\d]+[\/-][\d]+"
re.Global = True
For Each match In re.Execute(s)
if IsDate(match.value) then
FormatOutput = CDate(match.value)
Exit For
end if
Next
Set re = Nothing
End Function
'*********************************************
Function ReadFile(path,mode)
Const ForReading = 1
Dim objFSO,objFile,i,strLine
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(path,ForReading)
If mode = "byline" then
Dim arrFileLines()
i = 0
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(i)
strLine = objFile.ReadLine
strLine = Trim(strLine)
If Len(strLine) > 0 Then
arrFileLines(i) = strLine
i = i + 1
ReadFile = arrFileLines
End If
Loop
objFile.Close
End If
If mode = "all" then
ReadFile = objFile.ReadAll
objFile.Close
End If
End Function
'*****************************************************************
Please advice how changes the current single incoming log file to search multiple files.
Dim strTextToFind, strInputFile, strOutputFile, boolMatchCaseSensitive
Dim objFSO, objInputFile, strFoundText, strLine, objOutputFile
strTextToFind = Inputbox("Enter the text you would like to search for.")
strInputFile = "C:\Users\mmmanima\Desktop\mani\Day_16.txt"
iF YOU CAN NOTICED, IM ONLY ACCESS THE day_16 FILE
strOutputFile = "C:\Users\mmmanima\Desktop\texting As\result.txt"
Set objFSO = CreateObject("Scripting.FilesystemObject")
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
Do until objInputFile.atEndOfStream
strLine = objInputFile.ReadLine
If InStr(strLine,strTextToFind) > 0 Then
strFoundText = strLine
If strFoundText <> "" Then
Set objOutputFile = objFSO.OpenTextFile(strOutputFile,intForAppending, True)
objOutputFile.WriteLine strFoundText
objOutputFile.Close
Set objOutputFile = Nothing
End If
End If
loop
objInputFile.Close
Set objInputFile = Nothing
WScript.Quit
VBScript required to search userinput string into the share folder and there is 60 files.
As I believe you want to search through the all files in a particular folder. Then I suggest you to loop you action while all files are read
to do that it's easier to maintain sub or function
pseudo:
var inputFolder = ".\myfolder"
foreach file in the inputFolder
{
inputFile = file
searchIn(inputFile)
}
sub searchIn(inputFile)
{
'do your current works here
}
code:
This part will give you the all file names
Set fso = CreateObject("Scripting.FileSystemObject")
inputFldr = Replace(wscript.scriptfullname,wscript.scriptname,".\")
Set fldr = fso.getFolder(inputFldr)
For Each file In fldr.Files
'call to your function
Next
----------plese aware of typos------
Dim strTextToFind, strInputFile, strOutputFile, boolMatchCaseSensitive
Dim objFSO, objInputFile, strFoundText, strLine, objOutputFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
inputFldr = Replace(wscript.scriptfullname,wscript.scriptname,".\")
Set fldr = objFSO.getFolder(inputFldr)
strTextToFind = Inputbox("Enter the text you would like to search for.")
For Each file In fldr.Files
yourFunctionName(file )
Next
sub yourFunctionName(inputFile)
strInputFile = inputFile
strOutputFile = ".\result.txt"
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
Do until objInputFile.atEndOfStream
strLine = objInputFile.ReadLine
If InStr(strLine,strTextToFind) > 0 Then
strFoundText = strLine
If strFoundText <> "" Then
Set objOutputFile = objFSO.OpenTextFile(strOutputFile,intForAppending, True)
objOutputFile.WriteLine strFoundText
objOutputFile.Close
Set objOutputFile = Nothing
End If
End If
loop
objInputFile.Close
Set objInputFile = Nothing
end sub
WScript.echo "done"
WScript.Quit
You can try this vbscript, i added a function BrowseForFolder()
Option Explicit
Dim strTextToFind,inputFldr,strInputFile,strOutputFile,path,fldr
Dim objFSO, objInputFile,strFoundText,strLine,objOutputFile,file,ws
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("wscript.Shell")
path = objFSO.GetParentFolderName(wscript.ScriptFullName)
strOutputFile = path & "\result.txt"
If objFSO.FileExists(strOutputFile) Then
objFSO.DeleteFile(strOutputFile)
End if
inputFldr = BrowseForFolder()
Set fldr = objFSO.getFolder(inputFldr)
strTextToFind = Inputbox("Enter the text you would like to search for it !","Enter the text you would like to search for it !","wscript")
For Each file In fldr.Files
Call Search(file,strTextToFind)
Next
ws.run strOutputFile
'***************************************************************************************************************
Sub Search(inputFile,strTextToFind)
strInputFile = inputFile
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
Set objInputFile = objFSO.OpenTextFile(strInputFile,intForReading, False)
Do until objInputFile.atEndOfStream
strLine = objInputFile.ReadLine
If InStr(strLine,strTextToFind) > 0 Then
strFoundText = strLine
If strFoundText <> "" Then
Set objOutputFile = objFSO.OpenTextFile(strOutputFile,intForAppending, True)
objOutputFile.WriteLine "The Path of file ===> "& DblQuote(strInputFile) & VbCRLF &_
"String found "& DblQuote(strTextToFind) & " ===> "& DblQuote(strFoundText) & VbCRLF & String(100,"*")
objOutputFile.Close
Set objOutputFile = Nothing
End If
End If
loop
objInputFile.Close
Set objInputFile = Nothing
End sub
'***************************************************************************************************************
Function BrowseForFolder()
Dim ws,objFolder,Copyright
Set ws = CreateObject("Shell.Application")
Set objFolder = ws.BrowseForFolder(0,"Choose the folder to search on it ",1,"c:\Programs")
If objFolder Is Nothing Then
Wscript.Quit
End If
BrowseForFolder = objFolder.self.path
end Function
'****************************************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************
A bit late in the day after such a long time gap to address Mara Raj's problem with Hackoo's script but here it is for any others who may be interested. On starting the script it automatically deletes any existing result.txt file. Should the script subsequently go on to find "no match" it fails to generate a results.txt file as it would normally do if there were a match. The simplest way to correct this is to insert:
If objFSO.FileExists(strOutputFile) Then
else
wscript.echo "No Matches Found"
wscript.Quit
end if
between "next" and "ws.run strOutputFile"
i need help with this VBScript
What I'm trying to do here is modify the logfile to remove the extra spaces inside. (I just got this script actually somewhere on the net.)
It works if i specify just a single file but I'm trying to modify multiple files. Using the wildcard character as i did below did not work either (sorry I'm not so good with vbs)
Also does anyone know how we can do this without creating a new output file? just modify the original file. Thanks in advance..
Set objFSO = CreateObject("Scripting.FileSystemObject")
'change this line to wherever you want to read the input from.
Set objTextFile = objFSO.OpenTextFile("D:\access*.log",1)
Set objNewFile = objFSO.CreateTextFile("D:\access*_new.log")
Do Until objTextFile.AtEndOfStream
myString = objTextFile.Readline
objNewFile.WriteLine(Replace (myString, " ", " "))
Loop
In addition to my comment: The Scripting Guy explains exactly your replacement case: multiple spaces by one, with a regular expression:
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Global = True
objRegEx.Pattern = " {2,}"
strSearchString = _
"Myer Ken, Vice President, Sales and Services"
strNewString = objRegEx.Replace(strSearchString," ")
Wscript.Echo strNewString
The Scripting Guy also explains how you can change a text file:
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\Scripts\Text.txt", ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Jim ", "James ")
Set objFile = objFSO.OpenTextFile("C:\Scripts\Text.txt", ForWriting)
objFile.WriteLine strNewText
objFile.Close
And on the same technet.microsoft you can find how you can easily iterate over all files. You can use a regular expression again to see if the file is matching your (wildcard) pattern, in your case ^access.*\.log$:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\FSO")
Set colFiles = objFolder.Files
For Each objFile in colFiles
Wscript.Echo objFile.Name, objFile.Size
Next
This should give you all the ingredients to create your script.
The freeze-dried version:
Const ForReading = 1
Const ForWriting = 2
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Dim reZap : Set reZap = New RegExp
reZap.Global = True
reZap.Pattern = " +"
Dim oFile
For Each oFile In goFS.GetFolder("..\testdata\14620676").Files
WScript.Echo "----", oFile.Name
Dim sAll : sAll = oFile.OpenAsTextStream(ForReading).ReadAll()
WScript.Echo sAll
oFile.OpenAsTextStream(ForWriting).Write reZap.Replace(sAll, " ")
WScript.Echo oFile.OpenAsTextStream(ForReading).ReadAll()
Next
that makes no sense at all without #AutomatedChaos' admirable contribution (+1), but avoids growing the file's tail by using .Write instead of .WriteLine.
Following VBScript reads txt file and prints its contents. But, it does not show characters such as äåö. Can someone help me to know how to read?
Set objFS = CreateObject("Scripting.FileSystemObject")
inputDir = "c:\input\"
inpFile = ""
inpFileCount = 0
Set objFolder = objFS.GetFolder(inputDir)
For Each objFile in objFolder.Files
If LCase(objFS.GetExtensionName(objFile.name)) = "txt" Then
inpFile = objFile.Path
inpFileCount = inpFileCount + 1
End If
Next
If inpFileCount > 1 Then
WScript.Quit(1)
End If
Set objFile = objFS.OpenTextFile(inpFile)
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
If strLine <> Empty Then
WScript.Echo strLine
End If
Loop
I managed to solve it by just copying the file to destination. Though it is not good, but it works for me.
If objFS.FileExists(inpFile) Then
destinationFile = "D:\Test\refkoder.txt"
objFS.CopyFile inpFile, destinationFile, True
End If
How to save all text with replaced text.
At now save only replaced text
I want to change only 9752951c-0392-71e1-01a3- ac10016b0000 in txt
1.txt
text ...
<URL>http://bs.com/opr-console/rest/9.10/event_list/9752951c-0392-71e1-01a3- ac10016b0000</URL>
<method>PUT</method>
<auth-methods>DIGEST</auth-methods>
<auth-preemptive>true</auth-preemptive>
<auth-username>admin</auth-username>
<auth-password>rO0ABXQABWFkbWlu</auth-
.....bla-bla-la..
vbs script:
Dim objExec, objShell, objWshScriptExec, objStdOut, objArgs, ReplaceWith
Const ForReading = 1
Const ForWriting = 2
Set objArgs = WScript.Arguments
strID = Trim(objArgs(0))
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "^<URL>http://bsmgw.bms.consulting.com/opr-console/rest/9.10/event_list/"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\test\1\1.txt", 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
st = Mid(strSearchString, 71, 36)
WScript.Echo st
strNewFileName = Replace(strSearchString, st, strID)
Wscript.Echo strNewFileName
objFile.Write
Next
End If
Loop
objFile.Close
objFile.Close
objFile.Close
Personally, I would make changes to your file using an XML parser instead:
' load the document into an object
Dim xmldoc: set xmldoc = CreateObject("MSXML2.DomDocument")
xmldoc.async = false
xmldoc.setProperty "SelectionLanguage", "XPath"
xmldoc.load "C:\test\1\1.txt"
' get the URL node (look up XPath - i'm assuming that there is a single node called URL)
dim urlnode: set urlnode = xmldoc.selectSingleNode("//URL")
' replace the innerText of the URL node with your replacement text
urlnode.text = strID
'save your document
xmldoc.Save "C:\test\1\2.txt"