VBS adding lines to text file without spaces - vbscript

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 = ""

Related

How can I get file details in subfolders recursively?

I'm trying to compile a list of specific details about the music files on my computer, but my knowledge of VBS is limited. (Actually, I've done some VBA, but no VBS before.) I found two scripts online: one gets the file details in a folder and the other lists the names of subfolders and files recursively. I'm trying to combine the two but I'm running into problems because the first script starts with CreateObject("Shell.Application") and the second starts with CreateObject("Scripting.FileSystemObject"). This (i.e., Shell vs. FSO) is one of the areas of VBS scripting about which my knowledge is lacking, to put it mildly.
The incompatibility in my script appears in the For Each objFile in colFiles loop, which I inserted from the "Shell script" I referred to above. What can I do to make this script work?
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim StartFolder, FileName, fso, MyFile, Tabs, arrDetails(4)
Tabs = ""
arrDetails(0) = 0
arrDetails(1) = 1
arrDetails(2) = 27
arrDetails(3) = 28
StartFolder = "C:\Users\user\Music\MP3s"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(StartFolder)
FileName = "C:\Users\user\Documents\MP3 File Details.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.OpenTextFile(FileName, ForAppending, True, True)
MyFile.WriteLine objFolder.Path
ShowSubfolders objFSO.GetFolder(StartFolder), Tabs, arrDetails
Sub ShowSubFolders(Folder, ByVal Tabs, arrDetails)
Dim TabsFolder, TabsFiles, FileLine, arrText(4), i, d
TabsFolder = Tabs & "" & vbtab & ""
For Each Subfolder in Folder.SubFolders
MyFile.WriteLine
MyFile.WriteLine TabsFolder & Subfolder.Name
TabsFiles = TabsFolder & "" & vbtab & ""
Set objSubFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objSubFolder.Files
'Original inserted code for getting file details
' For Each strFileName in objFolder.Items
' For i = 0 to 3
' d = arrDetails(i)
' arrText(i) = objFolder.GetDetailsOf(strFileName, d)
' Next
'
' FileLine = arrText(0)
' For i = 1 to 3
' FileLine = FileLine & vbtab & arrText(i)
' Next
' MyFile.WriteLine FileLine
' Next
'Attempt to make code compatible with rest of script
For Each objFile in colFiles
If LCase(InStr(1, objFile.Name, ".mp3")) > 1 then
For i = 0 to 3
d = arrDetails(i)
arrText(i) = colFiles.GetDetailsOf(objFile, d)
Next
FileLine = arrText(0)
For i = 1 to 3
FileLine = FileLine & vbtab & arrText(i)
Next
MyFile.WriteLine TabsFiles & FileLine
End If
Next
ShowSubFolders Subfolder, TabsFolder, arrDetails
Next
End Sub
MyFile.Close
You do need both the FileSystemObject and the Windows Shell object in this case. You use the FileSystemObject to loop through the folders. In each folder, you then use the Windows Shell object to get the file details.
Here's a modified ShowSubFolders Sub that will work as expected:
Sub ShowSubFolders(Folder, Tabs, arrDetails)
Dim TabsFolder, TabsFiles, FileLine, arrText(4), i, d
Dim objShell
Dim objFolder
Dim objSubfolder
Dim objFiles
Dim objFile
Dim sFileName
Set objShell = CreateObject("Shell.Application")
TabsFolder = Tabs & "" & vbTab & ""
For Each objSubfolder In Folder.SubFolders
' Write subfolder to file
MyFile.WriteLine
MyFile.WriteLine TabsFolder & objSubfolder.Name
' Increment tab position
TabsFiles = TabsFolder & "" & vbTab & ""
Set objFolder = objShell.Namespace(objSubfolder.Path)
Set objFiles = objSubfolder.Files
For Each sFileName In objFolder.Items
' Check if file is MP3
If InStr(1, LCase(sFileName), ".mp3") > 0 Then
' Get file details
For i = 0 To 3
d = arrDetails(i)
arrText(i) = objFolder.GetDetailsOf(sFileName, d)
Next
' Build file information line
FileLine = arrText(0)
For i = 1 To 3
FileLine = FileLine & vbTab & arrText(i)
Next
' Write file information to file
MyFile.WriteLine TabsFiles & FileLine
End If
Next
' Call recursively to handle subfolders
ShowSubFolders objSubfolder, TabsFolder, arrDetails
Next
End Sub
The code you had commented out was good and made accessing extended file properties (like length and bitrate in your case) possible using the arrDetails you have.
Also included in this revised sub is the fix Arno Van Boven mentioned in the comments regarding flipping InStr and LCase.

Reading script and replacing specific line. vbscript

I'm developing a script that encrypts a users Tacacs-password, and writes this string into another script. My script opens, reads & writes the Tacacs-password into my other script but it doensn't overwrite it.
First run:
strTacacs = "Test1234"
Second run:
strTacacs = "Test1234"strTacacs = "Test1234"
My current script:
'***********Write to auto-logon script************
Const ForReading = 1
Const ForWriting = 2
newline = "strTacacs = " & chr(34) & Tacacs & chr(34)
line = 30
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim lineCount : lineCount = 0
Dim firstContent : firstContent = ""
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
If LCase(objFSO.GetExtensionName(objFile)) = "vbs" Then
lineCount = 0
firstContent = ""
FileName = objStartFolder & objFile.Name
Set objStream = objFSO.OpenTextFile(strFile, ForReading)
Do Until objStream.AtEndOfStream
lineCount = lineCount + 1
firstContent = firstContent & objStream.ReadLine & vbCrLf
'msgbox(firstContent)
if lineCount = 30 Then
firstContent = firstContent & newline
msgbox(firstContent)
End if
Loop
Set objStream = objFSO.OpenTextFile(FileName, ForWriting)
objStream.WriteLine firstContent
objStream.Close
End If
Next
.
Does anybody know what I'm doing wrong?
I'm new in the world of scripting so your help is greatly appreciated!
Thx!
It looks like you are writing both the original line and the new line when you get to line 30. You should only write newline when lineCount is 30 and write the original line otherwise:
Do Until objStream.AtEndOfStream
lineCount = lineCount + 1
If lineCount = 30 Then
' Replace line with newline
firstContent = firstContent & newline & vbCrLf
Else
' Write original line
firstContent = firstContent & objStream.ReadLine & vbCrLf
End If
Loop
If you know the password in the original file, you could read the whole file content in one shot using ReadAll method:
Set objStream = objFSO.OpenTextFile(strFile, ForReading)
firstContent = objStream.ReadAll
then use Replace to replace the password, and finally write the content back.
You current line-by-line approach is easier if you don't know the password and simply replace a specific line. You could also check if line starts with strTacacs = which gets you away from hardcoding the line number:
Dim sLine
Dim sPasswordLine
sPasswordLine = "strTacas ="
Do Until objStream.AtEndOfStream
' Read line
sLine = objStream.ReadLine
If Left(sLine, Len(sPasswordLine)) = sPasswordLine Then
' Replace line with newline
firstContent = firstContent & newline & vbCrLf
Else
' Write original line
firstContent = firstContent & sLine & vbCrLf
End If
Loop

How to append text from one file to another file after a specific line using VBScript?

I need to insert the contents of a text file into another existing text file after the line with a specific word in it.
Here is my code.
'//OPEN FILE and READ
Set objFileToRead = fso.OpenTextFile(ActiveDocument.Path & "\file.txt", 1)
strFileText = objFileToRead.ReadAll()
objFileToRead.Close
objStartFolder = ActiveDocument.Path
Set objFolder = fso.GetFolder(objStartFolder)
Set colFiles = objFolder.files
For Each objFile In colFiles
If fso.GetExtensionName(objFile.Name) = "opf" Then
filename = objFile.Name
End If
Next
MsgBox filename
'///PASTE
If fso.FileExists(ActiveDocument.Path & "\" & filename) Then
MsgBox filename
Set objFile = fso.OpenTextFile(ActiveDocument.Path & "\" & filename)
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
If InStr(strLine, "<manifest>") = 1 Then
MsgBox filename
objFile.WriteLine vbCrLf & strFileText
objFile.Close
End If
Loop
End If
I get a bad file error in the following line
objFile.WriteLine vbCrLf & strFileText
Can anyone please tell me what is wrong and what I have to do?
You can't write to a file that was opened for reading.
Either write the modified content to a temporary file and replace the original file with it afterwards:
p = fso.BuildPathActiveDocument.Path, filename)
Set f1 = fso.OpenTextFile(p)
Set f2 = fso.OpenTextFile(p & ".tmp", 2, True)
Do Until f1.AtEndOfStream
line = f1.ReadLine
f2.WriteLine line
If InStr(line, "<manifest>") = 1 Then f2.WriteLine strFileText
Loop
f1.Close
f2.Close
fso.DeleteFile p, True
fso.GetFile(p & ".tmp").Name = filename
or read the entire content into memory before writing the modified content back to the original file:
p = fso.BuildPathActiveDocument.Path, filename)
txt = Split(fso.OpenTextFile(p).ReadAll, vbNewLine)
Set f = fso.OpenTextFile(p, 2)
For Each line In original
f.WriteLine line
If InStr(line, "<manifest>") = 1 Then f.WriteLine strFileText
Next
f.Close
Note that the latter shouldn't be used for large files, lest your computer come grinding to a halt due to memory exhaustion.

Reading text file gives me weird string chain. cant get throu making a string variable of lines in text file

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)

Replace a specific string with the filename?

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) }

Resources