Vbs How to edit a text file through inputbox - vbscript

I want to make a program that edits a text file every time you open it
Here is what I have:
Dim firstNameInput
Dim lastNameInput
firstNameInput = inputbox("Please enter your name")
lastNameInput = inputbox("Enter your last name")
The rest of the code has to edit 1 specific text file: C:\Users\Me\Desktop\Edit.txt then write the name and last name on a new line
If there is anyone who could help I would be great full, thanks.

Try something like that to append data :
Option Explicit
Const ForAppending = 8
Dim ws,fso,RootFolder,MyFile,firstNameInput,lastNameInput,fileStream
Do
firstNameInput = inputbox("Please enter your name")
Loop Until firstNameInput <> ""
Do
lastNameInput = inputbox("Enter your last name")
Loop Until lastNameInput <> ""
Set Ws = CreateObject("Wscript.Shell")
RootFolder = Ws.ExpandEnvironmentStrings("%USERPROFILE%\Desktop")
MyFile = RootFolder & "\Edit.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileStream = fso.OpenTextFile(MyFile,ForAppending,True)
fileStream.WriteLine String(50,"*")
fileStream.WriteLine "First name: " & firstNameInput
fileStream.WriteLine "Last name: " & lastNameInput
fileStream.Close
ws.run DblQuote(MyFile)
'*****************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************
Another version. Just give a try !
Option Explicit
Const ForAppending = 8
Dim ws,fso,RootFolder,MyFile,firstNameInput,lastNameInput,fileStream
Dim Question,Title
Title = "Put Informations in file"
Set Ws = CreateObject("Wscript.Shell")
Call MyInputBox()
Do
Question = MsgBox("Did you want to add another data to file",VbYesNo+VbQuestion,Title)
If Question = VbYes Then
Call MyInputBox()
Else
ws.run DblQuote(MyFile)
Wscript.Quit()
End If
Loop Until Question = VbNo
'********************************************************************
Sub MyInputBox()
Do
firstNameInput = inputbox("Please enter your name")
Loop Until firstNameInput <> ""
Do
lastNameInput = inputbox("Enter your last name")
Loop Until lastNameInput <> ""
RootFolder = Ws.ExpandEnvironmentStrings("%USERPROFILE%\Desktop")
MyFile = RootFolder & "\Edit.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileStream = fso.OpenTextFile(MyFile,ForAppending,True)
fileStream.WriteLine "First name: " & firstNameInput
fileStream.WriteLine "Last name: " & lastNameInput
fileStream.WriteLine String(30,"*")
fileStream.Close
End Sub
'********************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'********************************************************************

Related

Vbscript Website Content, SelectAll Copy and Past into a Notepad *Help*

I got the code to copy the contents of a website into notepad:
With CreateObject("InternetExplorer.Application")
.Visible = False
.Navigate "https://example.com"
Do Until .ReadyState = 4
Wscript.Sleep 100
Loop
For Each Tag In .Document.GetElementsByTagName("script")
Tag.OuterHtml = ""
Next
For Each Tag In .Document.GetElementsByTagName("noscript")
Tag.OuterHtml = ""
Next
Content = .Document.GetElementsByTagName("body")(0).InnerText
Do While InStr(Content, vbCrLf & vbCrLf)
Content = Replace(Content, vbCrLf & vbCrLf, vbCrLf)
Loop
ShowInNotepad Content
.Quit
End With
Sub ShowInNotepad(Content)
With CreateObject("Scripting.FileSystemObject")
TempPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%TEMP%") & "\" & .GetTempName
With .CreateTextFile(TempPath, True, True)
.WriteLine (Content)
.Close
End With
CreateObject("WScript.Shell").Run "notepad.exe " & TempPath, 1, True
.DeleteFile (TempPath)
End With
End Sub
I am stuck with above script to save the text as file.txt.
Please help.
Try something like that :
Option Explicit
Dim LogFile,Ws,Tag,Content
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "txt"
Set Ws = CreateObject("wscript.Shell")
With CreateObject("InternetExplorer.Application")
.Visible = False
.Navigate "https://example.com"
Do Until .ReadyState = 4
Wscript.Sleep 100
Loop
For Each Tag In .Document.GetElementsByTagName("script")
Tag.OuterHtml = ""
Next
For Each Tag In .Document.GetElementsByTagName("noscript")
Tag.OuterHtml = ""
Next
Content = .Document.GetElementsByTagName("body")(0).InnerText
Do While InStr(Content, vbCrLf & vbCrLf)
Content = Replace(Content, vbCrLf & vbCrLf, vbCrLf)
Loop
WriteLog Content,LogFile
.Quit
End With
Ws.Run LogFile
'*******************************************************************
Sub WriteLog(strText,LogFile)
Dim fso,ts
Const ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(LogFile,ForWriting,True,-1)
ts.WriteLine strText
ts.Close
End Sub
'******************************************************************

Sync outlook messages with vbscript

I have a vbscript that copy's Outlook 2003 messages into a folder in msg format.
The problems are:
I am getting "path too long" errors for some *.msg . I wish to avoid these erros and I don't know how. ' On Error Resume Next is already on the script.
I am getting only inbox messages, but I want all subfolders too;
How can I extract this in *.txt and not in *.msg, in order to become lighter?
Here is my atual script. Thanks for the help!
On Error Resume Next
Dim myNameSpace
Dim ofChosenFolder
Dim myOlApp
Dim myItem
Dim objItem
Dim myFolder
Dim strSubject
Dim strName
Dim strFile
Dim strReceived
Dim strSavePath
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Const olFolderInbox = 6
Set ofChosenFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
strSavePath = "c:\test\" 'OBS! use a \ at the end of the path
i = 1
For each Item in ofChosenFolder.Items
Set myItem = ofChosenFolder.Items(i)
strReceived = ArrangedDate(myitem.ReceivedTime)
' strSubject = myItem.Subject
strSubject = myitem.SenderName & "_" & myitem.Subject
strName = StripIllegalChar(strSubject)
strFile = strSavePath & strReceived & "_" & strName & ".msg"
If Not Len(strfile) > 256 then
myItem.SaveAs strfile, 3
Else
wscript.echo strfile & vbcrlf & "Path and filename too long."
End If
i = i + 1
next
Function StripIllegalChar(strInput)
'***************************************************
'Simple function that removes illegal file system
'characters.
'***************************************************
Set RegX = New RegExp
RegX.pattern = "[\" & chr(34) & "\!\#\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]"
RegX.IgnoreCase = True
RegX.Global = True
StripIllegalChar = RegX.Replace(strInput, "")
Set RegX = nothing
End Function
Function ArrangedDate(strDateInput)
'***************************************************
'This function re-arranges the date data in order
'for it to display in chronilogical order in a
'sorted list in the file system. It also removes
'illegal file system characters and replaces them
'with dashes.
'Example:
'Input: 2/26/2004 7:07:33 AM
'Output: 2004-02-26_AM-07-07-33
'***************************************************
Dim strFullDate
Dim strFullTime
Dim strAMPM
Dim strTime
Dim strYear
Dim strMonthDay
Dim strMonth
Dim strDay
Dim strDate
Dim strDateTime
Dim RegX
If not Left(strDateInput, 2) = "10" Then
If not Left(strDateInput, 2) = "11" Then
If not Left(strDateInput, 2) = "12" Then
strDateInput = "0" & strDateInput
End If
End If
End If
strFullDate = Left(strDateInput, 10)
If Right(strFullDate, 1) = " " Then
strFullDate = Left(strDateInput, 9)
End If
strFullTime = Replace(strDateInput,strFullDate & " ","")
If Len(strFullTime) = 10 Then
strFullTime = "0" & strFullTime
End If
strAMPM = Right(strFullTime, 2)
strTime = strAMPM & "-" & Left(strFullTime, 8)
strYear = Right(strFullDate,4)
strMonthDay = Replace(strFullDate,"/" & strYear,"")
strMonth = Left(strMonthDay, 2)
strDay = Right(strMonthDay,len(strMonthDay)-3)
If len(strDay) = 1 Then
strDay = "0" & strDay
End If
strDate = strYear & "-" & strMonth & "-" & strDay
'strDateTime = strDate & "_" & strTime
strDateTime = strDate
Set RegX = New RegExp
RegX.pattern = "[\:\/\ ]"
RegX.IgnoreCase = True
RegX.Global = True
ArrangedDate = RegX.Replace(strDateTime, "-")
Set RegX = nothing
End Function
You need to truncate the file name appropriately (strName)
Move your code that processes a folder into a sub that take fodler that takes folder as parameter and call it for ofChosenFolder as well as all of its child fodlers in the ofChosenFolder.Folders collection.
You are calling SaveAs..., 3 - 3 here is olMsg. Specify olTxt (= 0).
Off the top of my head:
Const olFolderInbox = 6
Set ofChosenFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
trSavePath = "c:\test\"
ProcessFolder ofChosenFolder, trSavePath
sub ProcessFolder(folder, path)
For each Item in folder.Items
strReceived = ArrangedDate(Item.ReceivedTime)
strSubject = Item.SenderName & "_" &Item .Subject
strName = StripIllegalChar(strSubject)
strFile = strSavePath & strReceived & "_" & strName & ".msg"
If Not Len(strfile) > 256 then
Item.SaveAs strfile, 3
Else
wscript.echo strfile & vbcrlf & "Path and filename too long."
End If
next
for each subfolder in folder.Folders
ProcessFolder(subfolder, trSavePath & subfolder.Name & "\"
next
end sub

Using VBS to Backup a file

I managed to find this script to use and backup my files, this is a little more complicated then I need it to be.
I do not need to enter a backup path - from and too every time I run it however this is a handy option for other projects but I would like to backup from a set file path and save to a set file path to save time.
The other issue with this script is the Cancel button does not work, this is an issue I have had before and fixed but I cannot remember how to make the Cancel button function.
Option Explicit
Dim objFSO, strSourceFolder, strDestFolder, strExclusion, strPrompt
Set objFSO = CreateObject("Scripting.FileSystemObject")
strSourceFolder = InputBox("Enter the Source directory path you wish to backup")
strDestFolder = InputBox("Enter the Destination directory path you wish to backup your Data to... (C:/Backup, //Backup-Server/Remotebackup")
Wscript.Echo "Click (OK) to start the Backup!"
CopyFolderStructure strSourceFolder, strDestFolder, strExclusion
Function CopyFolderStructure(strSource, strDestination, strExcludedExt)
Const OVER_WRITE_FILES = True
Dim objDir, objFolder, objFiles, strCurExt, intX, arrExt, blnExclude
Set objDir = objFSO.GetFolder(strSource)
If Not objFSO.FolderExists(strDestination & "\" & objDir.Name) Then
objFSO.CreateFolder(strDestination & "\" & objDir.Name)
End If
If Not IsNoData(strExcludedExt) Then
arrExt = Split(strExcludedExt, ",")
blnExclude = False
End If
For Each objFiles In objFSO.GetFolder(strSource).Files
If Not IsNoData(strExcludedExt) Then
strCurExt = objFSO.GetExtensionName(objFiles.Name)
For intX = 0 To UBound(arrExt)
If LCase(strCurExt) = arrExt(intX) Then
blnExclude = True
Exit For
Else
blnExclude = False
End If
Next
If Not blnExclude Then
objFSO.CopyFile strSource & "\" & objFiles.Name, strDestination & "\" & objDir.Name & "\" & objFiles.Name, OVER_WRITE_FILES
End If
Else
objFSO.CopyFile strSource & "\" & objFiles.Name, strDestination & "\" & objDir.Name & "\" & objFiles.Name, OVER_WRITE_FILES
End If
Next
For Each objFolder In objFSO.GetFolder(strSource).SubFolders
CopyFolderStructure objFolder.Path, strDestination & "\" & objDir.Name, strExcludedExt
Next
End Function
Function BrowseForFolderDialogBox(strTitle)
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = &H0001
Dim objShellApp
Dim objFolder
Dim objFldrItem
Dim objPath
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.BrowseForFolder(WINDOW_HANDLE, strTitle , NO_OPTIONS)
If IsNoData(objFolder) Then
WScript.Echo "You choose to cancel. This will stop this script."
Wscript.Quit
Else
Set objFldrItem = objFolder.Self
objPath = objFldrItem.Path
BrowseForFolderDialogBox = objPath
Set objShellApp = Nothing
Set objFolder = Nothing
Set objFldrItem = Nothing
End If
End Function
Function IsNoData(varVal2Check)
On Error Resume Next
If IsNull(varVal2Check) Or IsEmpty(varVal2Check) Then
IsNoData = True
Else
If IsDate(varVal2Check) Then
IsNoData = False
Elseif varVal2Check = "" Then
IsNoData = True
ElseIf Not IsObject(varVal2Check) Then
IsNoData = False
Else
IsNoData = False
End If
End If
End Function
Wscript.Echo "Backup Has Completed Successfully"
Next code snippet could help (see Arguments Property (WScript Object), InputBox Function and MsgBox Function reference). Note that the Echo method behaves differently depending on which WSH engine you are using.
Option Explicit
Dim objFSO, strSourceFolder, strDestFolder, strExclusion, strPrompt
Dim iBut, sRes, sMes, objArgs
sRes = Wscript.ScriptName
sMes = vbCRLF & "(click (Cancel) button to discard)"
Set objArgs = WScript.Arguments
If objArgs.Count > 1 Then
strSourceFolder = objArgs( 0)
strDestFolder = objArgs( 1)
Else
strSourceFolder = "C:/DataToBackup"
strDestFolder = "D:/Backup"
strSourceFolder = InputBox( "Path you wish to backup" & sMes _
, "Source directory", strSourceFolder)
sRes = sRes & vbNewLine & "strSourceFolder """ & strSourceFolder & """"
If strSourceFolder = "" Then
strDestFolder = ""
Else
strDestFolder = InputBox( "Path you wish to backup your Data to" & sMes _
, "Destination directory", strDestFolder)
sRes = sRes & vbNewLine & "strDestFolder """ & strDestFolder & """"
End If
End If
If strDestFolder = "" Then
sRes = sRes & vbNewLine & "Backup Cancelled!"
Wscript.Echo sRes
Wscript.Quit
Else
iBut=MsgBox(sRes & sMes, vbOKCancel + vbQuestion _
, "Click (OK) to start the Backup!")
If iBut <> vbOK Then Wscript.Quit
End If
'''' for debugging only:
Wscript.Quit '''' for debugging only:
'''' for debugging only:
Set objFSO = CreateObject("Scripting.FileSystemObject")
CopyFolderStructure strSourceFolder, strDestFolder, strExclusion
'''''' and so on...

change name if exists when creating a txt file in Vbs

I want to make a program that gets user input and saves it in a text document, every time it saves a new document I want the file name to change
Here is what I have:
Option Explicit
Dim fso
Dim firstNameInput
Dim lastNameInput
Dim count
Dim testPath
Dim exists
Dim fileName
Dim fileStream
Dim filePath
Set fso = CreateObject("Scripting.FileSystemObject")
firstNameInput = inputbox("Please enter your name")
lastNameInput = inputbox("Enter your last name")
count = 1
do
testPath = "C:\Users\Me\Desktop\Info\peopleInfo" & count & ".txt"
exists = fso.FolderExists(testPath)
if(exists) then
count + 1
else
exit do
end if
loop
fileName = "peopleInfo" & count & ".txt"
filePath = "C:\Users\Me\Desktop\Info\"
Set fileStream = fso.CreateTextFile(filePath & fileName)
fileStream.WriteLine firstNameInput
fileStream.WriteLine lastNameInput
fileStream.Close
What I have doesn't seem to be working...
So every time I open this program, I want it to save the file as peopleInfo1 then peopleInfo2 then peopleInfo3 , etc.
Try something like that :
Option Explicit
Const RootFolder = "C:\Users\Me\Desktop\Info"
Dim fso,Folder,FirstFile,sFile,sFileNewName,firstNameInput,lastNameInput
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(RootFolder) Then
fso.CreateFolder(RootFolder)
End If
Set Folder = fso.GetFolder(RootFolder)
Do
firstNameInput = inputbox("Please enter your name")
Loop Until firstNameInput <> ""
Do
lastNameInput = inputbox("Enter your last name")
Loop Until lastNameInput <> ""
FirstFile = RootFolder &"\peopleInfo.txt"
If Not fso.FileExists(FirstFile) Then
Call Write2File(RootFolder & "\peopleInfo.txt")
Else
sFileNewName = GetNewName(FirstFile)
Call Write2File(sFileNewName)
End If
'************************************************************************************************************
Function GetNewName(sFile)
Dim snamebase,sname,Count,sTarget,MaxIncrementation
MaxIncrementation = 1000
snamebase = Split(Right(sFile, Len(sFile) - InStrRev(sFile,"\")),".")(0)
sname = snamebase
Count = 0
While Count < MaxIncrementation
sTarget = Folder & "\" & sname & ".txt"
If fso.FileExists(sTarget) Then
Count = Count + 1
sName = snamebase & "(" & Count & ")"
Else
GetNewName = sTarget
Exit Function
End If
Wend
End Function
'************************************************************************************************************
Sub Write2File(File)
Dim fileStream
Set fileStream = fso.CreateTextFile(File)
fileStream.WriteLine firstNameInput
fileStream.WriteLine lastNameInput
fileStream.Close
End Sub
'************************************************************************************************************
Or Something like that :
Option Explicit
Dim Ws,fso,RootFolder,Folder,FirstFile,sFile,sFileNewName,firstNameInput,lastNameInput,Desktop
Set Ws = CreateObject("Wscript.Shell")
RootFolder = Ws.ExpandEnvironmentStrings("%USERPROFILE%\Desktop\Info")
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(RootFolder) Then
fso.CreateFolder(RootFolder)
End If
Set Folder = fso.GetFolder(RootFolder)
Do
firstNameInput = inputbox("Please enter your name")
Loop Until firstNameInput <> ""
Do
lastNameInput = inputbox("Enter your last name")
Loop Until lastNameInput <> ""
FirstFile = RootFolder &"\peopleInfo.txt"
If Not fso.FileExists(FirstFile) Then
Call Write2File(RootFolder & "\peopleInfo.txt")
Else
sFileNewName = GetNewName(FirstFile)
Call Write2File(sFileNewName)
End If
'************************************************************************************************************
Function GetNewName(sFile)
Dim snamebase,sname,Count,sTarget,MaxIncrementation
MaxIncrementation = 1000
snamebase = Split(Right(sFile, Len(sFile) - InStrRev(sFile,"\")),".")(0)
sname = snamebase
Count = 0
While Count < MaxIncrementation
sTarget = Folder & "\" & sname & ".txt"
If fso.FileExists(sTarget) Then
Count = Count + 1
sName = snamebase & "(" & Count & ")"
Else
GetNewName = sTarget
Exit Function
End If
Wend
End Function
'************************************************************************************************************
Sub Write2File(File)
Dim fileStream
Set fileStream = fso.CreateTextFile(File)
fileStream.WriteLine firstNameInput
fileStream.WriteLine lastNameInput
fileStream.Close
End Sub
'************************************************************************************************************
The first problem is caused by your line:
exists = fso.FolderExists(testPath)
It should be
exists = fso.FileExists(testPath)
as you are looking for a file, not a folder.
The second problem is caused by your line
count + 1
It should be
count = count + 1
to assign the new/increased value to count.
Count is always starts at 1 because you say so. Count = 1. Store count in a file.

vbscript search string in multiple files

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"

Resources