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
Related
Ive written some code that loops through text files in a folder and updates them with an addiotnal header "TREATMENT_CODE" and then appends a code to the end of each line within each text file. The code is taken from the txt file name. Ive set this as a variable called TCode. The problem Im having is that the TCode variable isn't changing after the first loop through. Can anybody help? Thanks
Please excuse all of the msgbox lines, just me using them to figure out whats going on.
Code:
Option Explicit
Dim FSO, FLD, FIL, TS
Dim strFolder, strContent, strPath, FileName, PosA, TCode, rfile, Temp, dataToAppend, fulldata, wfile, TempArr, i
Const ForReading = 1, ForWriting = 2, ForAppending = 8
'Change as needed - this names a folder at the same location as this script
strFolder = "C:\Users\User1\OneDrive - Company/Documents\Temporary_delete_every_month\CRM_combiner_macro\Looping_test\files to amend"
'Create the filesystem object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get a reference to the folder you want to search
set FLD = FSO.GetFolder(strFolder)
'loop through the folder and get the file names
For Each Fil In FLD.Files
'MsgBox Fil.Path
'If UCase(FSO.GetExtensionName(Fil.Name)) = ".txt" Then
strPath = Fil.Path
'msgbox strPath
'strPath = Replace(strPath,"""","")
'msgbox strPath
posA = InStrRev(strPath, "\") +1
TCode = "|" & Mid(strPath, posA, 11)
msgbox "this is TCode " & TCode
Set fso = CreateObject("scripting.filesystemobject")
'msgbox "next file to amend" & strPath
Set rfile = fso.OpenTextFile(strPath, ForReading) 'File opened in Read-only mode
While Not rfile.AtEndOfStream
temp=rfile.ReadLine()
If rfile.Line=2 Then
dataToAppend = "|TREATMENTCODE"
ElseIf rfile.Line=3 Then
dataToAppend = TCode
End If
fulldata = fulldata & temp & dataToAppend & "|||"
Wend
rfile.Close
fulldata = Left(fulldata,Len(fulldata)-2)
Set wfile = fso.OpenTextFile(strPath, ForWriting) 'File opened in write mode
tempArr = Split(fulldata,"|||")
For i=0 To UBound(tempArr)
wfile.WriteLine tempArr(i)
Next
wfile.Close
Set fso= Nothing
'End If
'Clean up
Set TS = Nothing
Set FLD = Nothing
Set FSO = Nothing
set rfile = Nothing
set wfile = Nothing
set tempArr = Nothing
set Temp = Nothing
set TCode = Nothing
Next
MsgBox "Done!"
I have hundreds of filenames with a - (dash) 0 (zero) like V-45X-0892-0.pdf, V-45X-0893-0.pdf and would like to strip the -0 from filename.
Here's what I have but is not working.
folderspec = "C:\Dave\"
strRename = ""
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
For Each f1 In f.Files
Filename = folderspec & f1.Name
NewFilename = Replace(Filename, "%-0.pdf""%.pdf", strRename)
fs.MoveFile Filename, NewFilename
Next
MsgBox "All Done"
Here's code based on your Question with modifications made to the For Each loop. Note that you don't need to use MoveFile, you can simply update the file's Name property directly:
Dim objFSO
Dim objFolder
Dim objFile
Dim sFolderSpec
sFolderSpec = "C:\Dave\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(sFolderSpec)
For Each objFile In objFolder.Files
If InStr(objFile.Name, "-0") > 0 Then objFile.Name = Replace(objFile.Name, "-0", "")
Next
MsgBox "All Done"
How to replace a specific string with the filename? Example: I have several files with different names (like: Test.asp, Constant.asp, Letter.asp, etc.) within a subfolder that contain the text "ABC123". I would like to replace the "ABC123" in each file with the filename.
Below is the code I have that finds string and replaces it with a specific string but it doesn't do the job that I listed above.
Option Explicit
Dim objFilesystem, objFolder, objFiles, objFile, tFile, objShell, objLogFile,objFSO, objStartFolder, colFiles
Dim SubFolder, FileText, bolWriteLog, strLogName, strLogPath, strCount, strCount2, strOldText, strNewText, strEXT
bolWriteLog = True
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Set objFilesystem = WScript.CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
strLogName = "log.txt"
strLogPath = "C:\" & strLogName
strCount = 0
strCount2 = 0
strOldText = "ABC123"
strNewText = ""
strEXT = "asp"
'Initialize log file
If bolWriteLog Then
On Error Resume Next
Set objLogFile = objFileSystem.OpenTextFile(strLogPath, 2, True)
WriteLog "############### Start Log ##################"
If Not Err.Number = 0 Then
MsgBox "There was a problem opening the log file for writing." & Chr(10) & _
"Please check whether """ & strLogPath & """ is a valid file and can be openend for writing." & _
Chr(10) & Chr(10) & "If you're not sure what to do, please contact your support person.", vbCritical, "Script Error"
WScript.Quit
End If
On Error Goto 0
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "D:\MyFolder"
Set objFolder = objFSO.GetFolder(objStartFolder)
WScript.Echo objFolder.Path
Set colFiles = objFolder.Files
For Each objFile In colFiles
'WScript.Echo objFile.Name
' Now we have an exception for all files that can not be opened in text modus: all extensions such as "exe" should be listed upfront.
ReplaceText(objFile)
Next
ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ReplaceText(objFile)
If InStr(1, strEXT, Right(LCase(objFile.Name), 3)) = 0 Or objFile.Size = 0 Then
Else
strCount = strCount + 1
WriteLog("Opening " & objFile.Name)
Set tFile = objFile.OpenAsTextStream(ForReading, TriStateUseDefault)
FileText = tFile.ReadAll
tFile.Close
If InStr(FileText, strOldText) Then
WriteLog("Replacing " & strOldText & " with " & strNewText & ".")
FileText = Replace(FileText, strOldText, strNewText)
WriteLog("Text replaced")
Else
WriteLog(strOldText & " was not found in the file.")
strCount2 = strCount2 + 1
End If
Set tFile = objFile.OpenAsTextStream(ForWriting, TriStateUseDefault)
tFile.Write FileText
tFile.Close
FileText = ""
strCount = 0
strCount2 = 0
End If
End Sub
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
'WScript.Echo Subfolder.Path
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
'WScript.Echo objFile.Name
ReplaceText(objFile)
Next
ShowSubFolders Subfolder
Next
End Sub
WriteLog "############### EndLog ##################"
WScript.Echo "Script Complete"
objShell.Run "C:\" & strLogName
'Clear environment and exit
On Error Resume Next
Set tFile = Nothing
Set objFile = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objLogFile = Nothing
Set objFilesystem = Nothing
Set objShell = Nothing
WScript.Quit
'Subs and functions ********** DO NOT EDIT ***************
Sub WriteLog(sEntry)
If bolWriteLog Then objLogFile.WriteLine(Now() & ": Log: " & sEntry)
End Sub
I can give you a one line Ruby solution, should be not too difficult to translate that in Python but somewhat more extensive in VbScript I am afraid. First a generic search and replace version.
ARGV[0..-3].each{|f| File.write(f, File.read(f).gsub(ARGV[-2],ARGV[-1]))}
Save it in a script, eg replace.rb
You start in on the command line (here cmd.exe) with
replace.rb *.txt <string_to_replace> <replacement>
broken down so that I can explain what's happening but still executable
# ARGV is an array of the arguments passed to the script.
ARGV[0..-3].each do |f| # enumerate the arguments of this script from the first to the last (-1) minus 2
File.write(f, # open the argument (= filename) for writing
File.read(f) # open the argument (= filename) for reading
.gsub(ARGV[-2],ARGV[-1])) # and replace all occurances of the beforelast with the last argument (string)
end
And finally your request to replace ABC123 with the filename.
Of course tested and working
ARGV[0..-1].each{|f| File.write(f, File.read(f).gsub('ABC123', f))}
Contents of one of my testfiles (1.txt) after executing
test phrase
1.txt
EDIT
I see you want subfolder recursion on a fixed folder, no problem
Dir['**/*'].each{|f| File.write(f, File.read(f).gsub('ABC123', f)) unless File.directory?(f) }
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"