Hi I am novice in vbs script. I have one text file every line has statements like
minis1in use by bla bla
rit34in use by someone
atp34in use by someone2
I want a vbs script to convert this text file to
minis1 in use by bla bla
rit34 in use by someone
atp34 in use by someone2
I found one vbs script but it replaces string at particular position in every line. But I want to search for a number only in first string in every line and number may be one digit or two digit or three digit after that number it should give space. Without replacing character with a space.
StrFileName = "C:\Users\Desktop\Scheduled\output.txt"
Const ForReading = 1
Const ForWriting = 2
Dim objFSO
Dim objTF
Dim objRexex
Dim StrFileName
Dim strTxt
StrFileName = "C:\Users\Desktop\Scheduled\output.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile(StrFileName, ForReading)
Set objregex = CreateObject("vbscript.regexp")
strTxt = objTF.ReadAll
objTF.Close
With objregex
.Global = True
.MultiLine = True
.Pattern = "^(.{6})[^-](.*)$"
strTxt = .Replace(strTxt, "$1" & " " & "$2")
End With
Set objTF = objFSO.OpenTextFile(StrFileName, ForWriting)
objTF.Write strTxt
objTF.Close
Maybe the pattern "^(\w+)(\d+)(\w+)" used non-globally will do what you want:
Option Explicit
Dim r : Set r = New RegExp
r.Global = False ' just the first
r.Pattern = "^(\w+)(\d+)(\w+)"
Dim s
For Each s In Split("minis1in use by+rit34adv use+atp34in use not34in use+not here1in use", "+")
WScript.Echo s
WScript.Echo r.Replace(s, "$1$2 $3")
WScript.Echo
Next
output:
cscript 25228592.vbs
minis1in use by
minis1 in use by
rit34adv use
rit34 adv use
atp34in use not34in use
atp34 in use not34in use
not here1in use
not here1in use
If "every line has statements like" what you've shown, and you're sure of that, make it easy on yourself:
strTxt = Replace(strTxt, "in use by ", " in use by ")
Related
I have a script that is supposed to grab a file from a folder and attach it to an email.
The code runs but nothing happens. I assume it's because strLocation is empty.
Here is an example of the file path I am trying to grab:
"C:\Users\MChambers\Desktop\Pricing Reports\Pricing_Report_201908121239 Formatted.xlsx"
Option Explicit
Const olMailItem = 0
Function FindFirstFile(strDirPath, strPattern)
Dim strResult
Dim objRegExp, objMatches
Set objRegExp = New RegExp
objRegExp.Pattern = strPattern
objRegExp.IgnoreCase = True
Dim objFso, objFolder, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strDirPath)
For Each objFile in objFolder.Files
Set objMatches = objRegExp.Execute(objFile.Name)
If objMatches.Count > 0 Then
strResult = objMatches(0).Value
Exit For
End If
Next
If Len(strResult) > 0 Then
If Right(strDirPath, 1) <> "\" Then strDirPath = strDirPath & "\"
strResult = strDirPath & strResult
End If
FindFirstFile = strResult
End Function
Sub SendBasicEmail()
Dim olApp: Set olApp = CreateObject("Outlook.Application")
Dim olEmail: Set olEmail = olApp.CreateItem(olMailItem)
Dim strLocation
Dim strPattern
strPattern = "Pricing_Report_*Formatted.xlsx"
strLocation = FindFirstFile("C:\Users\MChambers\Desktop\Pricing Reports\", strPattern)
If strLocation <> "" Then
With olEmail
.SentOnBehalfOfName = "genericemail"
.Attachments.Add (strLocation)
.To = "myemail"
.Subject = "Subject"
.Send
End With
End If
End Sub
SendBasicEmail
Update: The solution below was correct. In addition, I had to call the sub directly at the end of the file which I have updated in the code above.
The pattern you're using doesn't do what you apparently think it does.
strPattern = "Pricing_Report_*Formatted.xlsx"
You seem to expect the above to do a wildcard match (i.e. "Pricing_Report_" followed by any amount of text and "Formatted.xlsx"). That is not how regular expressions work. * in a regular expression means "zero or more times the preceding expression". The character . also has a special meaning in regular expressions, which is "any character except line-feed. Because of that your pattern would actually match the string "Pricing_Report" followed by any number of consecutive underscores, the string "Formatted", any single character except line-feed, and the string "xlsx".
Change the pattern to this
strPattern = "Pricing_Report_.*Formatted\.xlsx"
and the code will do what you want.
For further information about regular expressions in VBScript see here.
I have text files that are approximately 6MB in size. There are some lines that contain the NULL (Chr(0))character that I would like to remove.
I have two methods to do this: using Asc()=0 but this takes approximately 50s to complete, the other method uses InStr (line, Chr(0)) =0 (fast ~ 4sec)but the results remove vital info from the lines which contain the NULL characters.
First line of text file as example:
##MMCIBN.000NULL7NULL076059NULL7653NULL1375686349NULL2528NULL780608NULL10700NULL\NULL_NC_ACT.DIR\CFG_RESET.INI
First method (works but VERY slow)
function normalise (textFile )
Set fso = CreateObject("Scripting.FileSystemObject")
writeTo = fso.BuildPath(tempFolder, saveTo & ("\Output.arc"))
Set objOutFile = fso.CreateTextFile(writeTo)
Set objFile = fso.OpenTextFile(textFile,1)
Do Until objFile.AtEndOfStream
strCharacters = objFile.Read(1)
If Asc(strCharacters) = 0 Then
objOutFile.Write ""
nul = true
Else
if nul = true then
objOutFile.Write(VbLf & strCharacters)
else
objOutFile.Write(strCharacters)
end if
nul = false
End If
Loop
objOutFile.close
end function
The output looks like this:
##MMCIBN.000
7
076059
7653
1375686349
2528
780608
10700
\
_NC_ACT.DIR\CFG_RESET.INI
Second method code:
filename = WScript.Arguments(0)
Set fso = CreateObject("Scripting.FileSystemObject")
sDate = Year(Now()) & Right("0" & Month(now()), 2) & Right("00" & Day(Now()), 2)
file = fso.BuildPath(fso.GetFile(filename).ParentFolder.Path, saveTo & "Output " & sDate & ".arc")
Set objOutFile = fso.CreateTextFile(file)
Set f = fso.OpenTextFile(filename)
Do Until f.AtEndOfStream
line = f.ReadLine
If (InStr(line, Chr(0)) > 0) Then
line = Left(line, InStr(line, Chr(0)) - 1) & Right(line, InStr(line, Chr(0)) + 1)
end if
objOutFile.WriteLine line
Loop
f.Close
but then the output is:
##MMCIBN.000\CFG_RESET.INI
Can someone please guide me how to remove the NULLS quickly without losing information. I have thought to try and use the second method to scan for which line numbers need updating and then feed this to the first method to try and speed things up, but quite honestly I have no idea where to even start doing this!
Thanks in advance...
It looks like the first method is just replacing each NULL with a newline. If that's all you need, you can just do this:
Updated:
OK, sounds like you need to replace each set of NULLs with a newline. Let's try this instead:
strText = fso.OpenTextFile(textFile, 1).ReadAll()
With New RegExp
.Pattern = "\x00+"
.Global = True
strText = .Replace(strText, vbCrLf)
End With
objOutFile.Write strText
Update 2:
I think the Read/ReadAll methods of the TextStream class are having trouble dealing with the mix of text and binary data. Let's use an ADO Stream object to read the data instead.
' Read the "text" file using a Stream object...
Const adTypeText = 2
With CreateObject("ADODB.Stream")
.Type = adTypeText
.Open
.LoadFromFile textFile
.Charset = "us-ascii"
strText = .ReadText()
End With
' Now do our regex replacement...
With New RegExp
.Pattern = "\x00+"
.Global = True
strText = .Replace(strText, vbCrLf)
End With
' Now write using a standard TextStream...
With fso.CreateTextFile(file)
.Write strText
.Close
End With
I tried this method (update2) for reading a MS-Access lock file (Null characters terminated strings in 64 byte records) and the ADODB.Stream didn't want to open an already in use file. So I changed that part to :
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(Lfile)
z = f.Size
set ts = f.OpenAsTextStream(ForReading, 0) 'TristateFalse
strLog = ts.Read(z)
ts.Close
set f = nothing
' replace 00 with spaces
With New RegExp
.Pattern = "\x00+"
.Global = True
strLog = .Replace(strLog, " ")
End With
' read MS-Access computername and username
for r = 1 to len(strLog) step 64
fnd = trim(mid(strLog,r, 32)) & ", " & trim(mid(strLog,r+32, 32)) & vbCrLf
strRpt = strRpt & fnd
next
I am writing a utility to collect all system information from all devices on a network to an XML document, and one of the values is a certain software version number. Unfortunately the version number is only stored in a single text file on each machine (c:\master.txt) the even more fun part is, each text file is formatted differently depending on the image that was used.
One could say
Product Number: 11dsSt2 BRANDONII,STNS6.0.2.200
The next
Ver: 22335TS BOX2 S6.1.3.011,STN
and so on.
What I did, is create a VBS that looks for a number pattern that matches the version pattern, which is
[A-Z]#.#.#.###
This works, however I just want to output that pattern, not the entire line. Here is my code. Any Suggestions?
Const ForReading = 1
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "[A-Z]{1}[0-9]{1}.[0-9]{1}.[0-9]{1}.[0-9]{3}"
objregex.global = true
objregex.ignorecase = true
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\master.txt", ForReading)
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
Addmatch
End If
Loop
objFile.Close
Sub Addmatch 'Creates a text file with the part number
Const ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile1 = objFSO.OpenTextFile("C:\test.txt", ForAppending, True)
objFile1.Writeline strSearchString
objFile1.Close
end sub
You're storing the entire line you read from the file (that you have in strSearchString) instead of just the matched text. Use something like this instead (untested!):
if ColMatches.Count > 0 then
AddMatch(ColMatches(0)) ' Just grab the matched text and pass to AddMatch
End If
Sub AddMatch(strMatchedText) ' Change to accept parameter of text to write out
' Other code
objFile1.Writeline strMatchedText
objFile1.Close
End Sub
Use the first/one and only match to obtain the value, and pass this to a slightly modified version of Addmatch:
If colMatches.Count > 0 Then
Addmatch colMatches(0).Value
End If
...
Sub Addmatch(sWhatToWriteLn) ' some truthful comment
Const ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile1 = objFSO.OpenTextFile("C:\test.txt", ForAppending, True)
objFile1.Writeline sWhatToWriteLn
...
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.
I have a file which has multiple lines.
It is required to have "-" after 8th position in every line.
I can read lines with "-" at 9th position, but I am not able to write "-" at the 9th position if it is not there.
Any help would be really appreciated.
You can't insert characters in a VBScript string, because these are immutable; you'll have to concatenate a new string from Left(sOrgStr, 8) & "-" & Mid( sOrgStr, 9). (The numbers are +-1 depending on how you count.)
This vbs will
open a file C:\temp\log.txt,
make a global change with a single regexo
write the new updated text back over the original file
Please change the path to your file to suit in this line
StrFileName = "C:\temp\log.txt"
Const ForReading = 1
Const ForWriting = 2
Dim objFSO
Dim objTF
Dim objRexex
Dim StrFileName
Dim strTxt
StrFileName = "C:\temp\log.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile(StrFileName, ForReading)
Set objregex = CreateObject("vbscript.regexp")
strTxt = objTF.ReadAll
objTF.Close
With objregex
.Global = True
.MultiLine = True
.Pattern = "^(.{8})[^-](.*)$"
strTxt = .Replace(strTxt, "$1" & "-" & "$2")
End With
Set objTF = objFSO.OpenTextFile(StrFileName, ForWriting)
objTF.Write strTxt
objTF.Close
you can fix the strings you read using this code:
s="input string"
if (mid(s,9,1)<>"-") then 'the 9th character isn't "-"
s=left(s,8) & "-" & mid(s,9)
end if
I suggest you'll open your file for input and re-write it into another text file.
You could use regular expressions.
If you're reading the lines 1-by-1 I think you need something like
Set objRe = New RegExp
' this will match any line having 9 or more characters,
' where the 9-th character is not "-", and capture the first 8 characters in the group #1
objRe.Pattern = "^(.{8})[^-]"
' Open the file, read lines, in the inner loop, call:
line = objRe.Replace( line, "$1-" ) ' This will replace the RE with the group #1 followed by '-'