I am trying to make a little script in VBS that saves command output to text file and then reading line by line from it and placing it straigh to variable.
Unfortunetly effects are weird. Instead of having a string with all lines from file I have weird chain like "ybN" (see the screenshot below). I tried to read file with many different ways found on the Internet but effects are worse or the same.
I noticed that command output is saving with many spaces after each text but I don't know if that's what causing the problem.
Any Suggestions?
Const ForWriting = 2
Const ForReading = 1
Set WshShell = CreateObject("WScript.Shell")
If WScript.Arguments.Length = 0 Then
Set ObjShell = CreateObject("Shell.Application")
ObjShell.ShellExecute "wscript.exe" _
, """" & WScript.ScriptFullName & """ RunAsAdministrator", , "runas", 1
WScript.Quit
End If
Set fsoObject = CreateObject("Scripting.FileSystemObject")
strFile = "D:\interfaces.txt"
WshShell.Run("%comspec% /C wmic nic where " & Chr(34) & "netconnectionid like '%'" & Chr(34) & " get netconnectionid >> " & Chr(34) & strFile & Chr(34))
WScript.Echo "Interface data pushed to text file at " & strFile
If fsoObject.FileExists(strFile) Then
If fsoObject.GetFile(strFile).Size <> 0 Then
Set objFile = fsoObject.OpenTextFile(strFile, ForWriting)
objFile.Write ""
objFile.Close
End If
End If
Set objFile = fsoObject.OpenTextFile(strFile, ForReading)
Do Until objFile.AtEndOfStream
strMsg = strMsg & objFile.ReadLine & vbNewLine
'strMsg = strMsg & strLine & vbNewLine
Loop
objFile.Close
sInput = InputBox("Choose network connection to configurate " & vbNewLine & strMsg, ,"Choose one option")
Screenshots:
Your file is Unicode-encoded (little endian UTF-16 to be precise). ÿþ is the byte order mark (BOM) for this encoding. You need to open it as such by setting the fourth parameter of OpenTextFile() to -1:
Set objFile = fsoObject.OpenTextFile(strFile, ForReading, False, -1)
Related
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) }
This is my first post, but I have been programming for a long time now
I just want to ask a quick question and the title explains it all. I want my VBS to run a file, but I dont want it to search just for a specific directory, I want it to just find the file if you know what I mean, because if I gave the script to anyone else, this file could be ANYWHERE on their computer.
This is the current couple of important lines that I am using for running files:
set wshshell = wscript.CreateObject("wscript.shell")
and
wshshell.run <program directory here>
You need a recursive function like this one searching for shortcuts.
Sub GenerateHotkeyInFolder(Fldr)
on error resume next
set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set FldrItems=Fldr.Items
For Each oFile in FldrItems
With oFile
If .IsFileSystem = true And .IsLink = true And .Type <> "Shortcut to MS-DOS Program" then
set lnk = WshShell.CreateShortcut(oFile.Path)
If lnk.hotkey <> "" then
Set fsop = fso.GetFile(.Path)
LnkName = "<b>" & fso.GetBaseName(fso.GetFile(.Path)) & "</b><br>" & fsop.ParentFolder.path & "\" & fso.GetBaseName(fso.GetFile(.Path)) & "." & fso.GetExtensionName(fso.GetFile(.Path))
TableVar = TableVar & "<tr><td><b>" & lnk.hotkey & "</b></td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.fullname & Chr(34) & ")'>" & lnkname & "</a>" & "</td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.targetpath & Chr(34) & ")'>" & lnk.targetpath & "</a></td></tr>" & vbcrlf
End If
ElseIf .IsFileSystem = true And .IsFolder = true then
GenerateHotkeyInFolder(.GetFolder)
End If
End With
Next
End Sub
I've looked over all the redirect/export command line to text file answers, but none work in this case. I am testing our software and need to run the application using several XML files. I've written the VBScript to run all XML in a folder against the application, but I need to capture everything in the command window to a text file (run.log).
Here is what I have cobbled together:
Option Explicit
Dim FSO, FLD, FIL, str, Expath, strFolder, objShell, objFSO, strFile, objFile
set objShell = WScript.CreateObject ("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
'defines values
strFile = "Run.log"
strFolder = "C:\SDK Testing PDFL 10\XML\"
Expath = "C:\Program Files\ICEsdk600022\bin\FineEyeProcessExe.exe"
objShell.CurrentDirectory = "C:\SDK Testing PDFL 10"
'defines the directory where the XML resides
set FLD = FSO.GetFolder(strFolder)
'defines loop parameters
For Each Fil In FLD.Files
'searches for XML files within loop
If UCase(FSO.GetExtensionName(Fil.name)) = "XML" Then
'builds commandline
str = chr(34) & Expath & chr(34) & chr(32) & chr(34) & strFolder & Fil.Name & chr(34)
'writes string to log
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile(strFolder & strFile, 8, True)
objFile.WriteLine(str)
objFile.Close
'runs command
objShell.Run str
'shows string
MsgBox str
'writes output to log
'set objFSO = CreateObject("Scripting.FileSystemObject")
'set objFile = objFSO.OpenTextFile(strFolder & strFile, 8, True)
'objFile.WriteLine()
'objFile.Close
End If
Next
You could modify this line..
objShell.Run str
..to something like this..
objShell.Run "cmd /c " & str & " > log.txt"
That will dump the output of C:\Program Files\ICEsdk600022\bin\FineEyeProcessExe.exe to log.txt
I'd like to write output from VBScript to notepad/wordpad in realtime. What's the best way to do this? I'm aware of sendkeys, but it requires that I parse the input for special commands.
SendKeys is the only method for writing to a third-party application in realtime. Why don't you use CScript and write to the standard output instead? That is what it is meant for.
' Force the script to run in the CScript engine
If LCase(Right(WScript.FullName, 11)) <> "cscript.exe" Then
strPath = WScript.ScriptFullName
strCommand = "%comspec% /k cscript " & Chr(34) & strPath & chr(34)
CreateObject("WScript.Shell").Run(strCommand)
WScript.Quit
End If
For i = 1 to 10
For j = 0 to 25
WScript.StdOut.WriteLine String(j, " ") & "."
WScript.Sleep 50
Next
For j = 24 to 1 Step - 1
WScript.StdOut.WriteLine String(j, " ") & "."
WScript.Sleep 50
Next
Next
Try this
Const fsoForWriting = 2
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Open the text file
Dim objTextStream
Set objTextStream = objFSO.OpenTextFile("C:\SomeFile.txt", fsoForWriting, True)
'Display the contents of the text file
objTextStream.WriteLine "Hello, World!"
'Close the file and clean up
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
trying to figure out how to modify the code below to add to a text file that happens to have an extra CRLF at the end of the file. I get confusing results depending on where I put the CHR(10). Any ideas how to strip the CRLF or remove the blank line? I need to end up with no extra CRLF's !!!
'This script will add lines to the RandomCSV file if it is not in a multiple of 20.
'If the file is already a mulitiple of 20, nothing should happen.
dim filesys, readfile, contents, lines, remainder, LinesToAdd, StaticLine, Appendfile, Count
dim field1, field2, field3, field4
set filesys = CreateObject("Scripting.FileSystemObject")
Set readfile = filesys.OpenTextFile("C:\RandomCSV.txt", 1, false)
contents = readfile.ReadAll
Lines = readfile.line
readfile.close
MsgBox "The file contains this many lines " & Lines
remainder = lines mod 20
LinesToAdd = (20 - remainder)
MsgBox "Adding this many lines " & LinesToAdd
If LinesToAdd <> 20 then
Set Appendfile = filesys.OpenTextFile("C:\RandomCSV.txt", 8, false)
For Count = 1 to LinesToAdd
Appendfile.write Chr(34) & "Field1" & Chr(34) & Chr(44) & Chr(34) & "Field2" & Chr(34) & Chr(44) & Chr(34) & "Field3" & Chr(34) & Chr(44) & Chr(34) & "Field4" & Chr(10)
Next
appendfile.close
End If
Here's what I ended up doing to get rid of the CRLF at the end of the file. Seems to work fine:
'============================
'Get rid of blank Line at End of file
Dim strEnd
Const ForReading = 1
'Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\RandomCSV.txt", ForReading)
strFile = objFile.ReadAll
objFile.Close
intLength = Len(strFile)
strEnd = Right(strFile, 2)
If strEnd = vbCrLf Then
strFile = Left(strFile, intLength - 2)
Set objFile = objFSO.OpenTextFile("C:randomCSV.txt", ForWriting)
objFile.Write strFile
objFile.Close
End If
strFile = ""