I am trying to loop a folder full of .html files and add some code at the beginning of the files (although I am getting some unwanted line breaks before the code I am inserting) and also to grab the contents of the <title> tag and use this for the renaming each file.
I am replacing the spaces and unwanted characters with -'s
All of this works but I am also trying to rename the existing file (Default0010.html is one example) to the text from the <title>.
This works too but when I am trying to move the existing file to the new file I get a Bad File name or Number but when I explicilty set the destination file name to a simple string it works.
It makes me thing my string is not clean or you cannot use a variable for the destination.
Also please ignore the lines Dim i, i = i + 1 and If i=1 Then Exit For.
This was added whilst I test the script then when I was happy it does what I wanted I would run it on all the HTML files.
Set objFso = CreateObject("Scripting.FileSystemObject")
Set Folder = objFSO.GetFolder("C:\My Web Sites\test\www.test.org.uk\html")
Dim i
Dim ObjFsoFile
Dim ObjFile
Dim StrData
Dim StrTitleTag
Dim OldFilename
Dim NewFilename
Set ObjFsoFile = CreateObject("Scripting.FileSystemObject")
'Loop all of the files
For Each File In Folder.Files
'Get contents of the file and store in a string
'Opening the file in READ mode
Set ObjFile = ObjFsoFile.OpenTextFile(File.Name)
'Reading from the file
StrData = ObjFile.ReadAll
'Add the Perch include to the beginning
StrData = replace(StrData,"<?php include('cms/runtime.php');?>","") 'Remove the Perch include in-case we are re-running this
StrData = replace(StrData,"<!DOCTYPE HTML PUBLIC " & Chr(34) & "-//W3C//DTD HTML 4.0 Transitional//EN" & Chr(34) & ">","<?php include('cms/runtime.php');?>" & vbcrlf & "<!DOCTYPE HTML PUBLIC " & Chr(34) & "-//W3C//DTD HTML 4.0 Transitional//EN" & Chr(34) & ">")
'Msgbox StrData
'Closing the file
ObjFile.Close
'Write the changes to the current file
Set objFile = objFSO.CreateTextFile(File.Name,True)
objFile.Write StrData
objFile.Close
'Re-write the contents of the current file and replace with the StrData Above
'Grab the contents between <title> and </title>
parse_string1 = StrData 'see above post
parse_string1 = replace(parse_string1,"<title>","¦")
parse_string = split(parse_string1,"¦")
parse = parse_string(1)
parse_string1 = replace(parse,"</title>","¦")
parse_string = split(parse_string1,"¦")
parsed_string = parse_string(0)
StrTitleTag = parsed_string 'gives final result
'Save old filename of current file to a string
OldFilename = File.Name
'Msgbox OldFilename
'Rename current file to the above contents of between <title> and </title>
'Replace spaces with - characters in the filename.
Dim divider
divider = "-"
'Replace & with and
NewFilename = Replace((StrTitleTag & ".php"),"&","and")
'Replace triple space with single space
NewFilename = Replace(NewFilename," "," ")
'Replace double space with single space
NewFilename = Replace(NewFilename," "," ")
'Replace - with space
NewFilename = Replace(NewFilename," ",divider)
'Replace ---- with -
NewFilename = Replace(NewFilename,divider & "-" & divider,divider)
'Replace ---- with -
NewFilename = Replace(NewFilename,divider & divider & divider,divider)
'Replace ,- with -
NewFilename = Replace(NewFilename,"," & divider,divider)
'Replace LineBreaks with nothing (remove line breaks)
NewFilename = Replace(NewFilename,vbCrLf,"")
NewFilename = Replace(NewFilename,vbLf,"")
NewFilename = Replace(NewFilename,vbCr,"")
NewFilename = LCase(NewFilename)
'Msgbox NewFilename
'Loop through all files
For Each File2 In Folder.Files
'Opening the file in READ mode
Set ObjFile = ObjFsoFile.OpenTextFile(File2.Name)
'Get contents of the file and store in a string
'Reading from the file
StrData = ObjFile.ReadAll
'Closing the file
ObjFile.Close
'Replace all occurences of the old filename with the new filename
StrData = Replace(StrData, OldFilename, NewFilename)
'How to write file
Set objFile = objFSO.CreateTextFile(File2.Name,True)
objFile.Write StrData
objFile.Close
Next
'Rename Old file with the new filename
If objFso.FileExists("C:\My Web Sites\test\www.test.org.uk\html\" & OldFilename) Then
'NewFileName = "test.php"
'NewFileName = "test-test-test-test-test-test-test-test-test.php"
Msgbox "Renaming the file " & OldFilename & " (Length: " & Len(OldFilename) & ") with the following name: " & NewFilename & " (Length: " & Len(NewFilename) & ")"
Msgbox "Compare: test-test-test-test-test-test-test-test-test.php " & NewFilename
objFso.MoveFile "C:\My Web Sites\test\www.test.org.uk\html\" & OldFilename, "C:\My Web Sites\test\www.test.org.uk\html\" & NewFileName
End If
i = i + 1
If i=1 Then Exit For
Next
Don't replace known bad characters. Replace everything that is not a known good character, e.g. by using a regular expression:
Set re = New RegExp
re.Pattern = "[^a-z0-9+._-]+"
re.Global = True
re.IgnoreCase = True
NewFilename = re.Replace(OldFilename, "_")
The underscore (_) usually is a safe character for this kind of replacement.
Also, don't try to manually parse elements from an HTML file unless you have to. In your case the title can be extracted far easier, like this:
Set html = CreateObject("HTMLFile")
html.Write objFso.OpenTextFile(File.Name).ReadAll
title = html.Title
It will even collapse and trim whitespace for you.
And a file can be renamed by simply changing its Name property when you already have a handle to that file:
objFile.Name = NewFilename
Simplified version of your script (without those parts that modify the content of the files):
Set fso = CreateObject("Scripting.FileSystemObject")
htmlFolder = "C:\My Web Sites\test\www.test.org.uk\html"
Set re = New RegExp
re.Pattern = "[^a-z0-9+._-]+"
re.Global = True
re.IgnoreCase = True
For Each f In objFso.GetFolder(htmlFolder).Files
data = f.OpenAsTextStream.ReadAll
Set html = CreateObject("HTMLFile")
html.Write data
oldname = f.Name
newname = re.Replace(f.Name, "_")
f.Name = newname
Next
Related
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.
Using below code I was able to add ; in the start of each line but the I want to add ; after a particular word is found e.g. [Abc]. How to do this using VBScript?
Const ForReading=1
Const ForWriting=2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set f = objFSO.OpenTextFile("D:\sam.txt", ForReading)
Do Until f.AtEndOfStream
strText = f.ReadLine
If Len(strText) = 0 Then
blnFound = True
MsgBox "blank line found"
strText = vbNewLine & strText
strContents = strContents & strText & vbCrlf
Else
strText = ";" & strText
strContents = strContents & strText & vbCrlf
End If
Loop
f.Close
Set f = objFSO.OpenTextFile("D:\sam.txt", Forwriting)
f.WriteLine strContents
f.Close
Sam.txt is containing some lines, e.g.
Hi, need help
This is a sample text file
[Abc]
How are you
Hope you are doing well!
So I want the output sam.txt file should have below data inside it:
Hi, need help
This is a sample text file
[Abc]
;How are you
;Hope you are doing well!
So, basically, you have an INI-style file and want the entries in a particular section commented. That can be achieved like this:
filename = "D:\sam.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
txt = Split(fso.OpenTextFile(filename).ReadAll, vbNewLine)
disable = False
For i = 0 To UBound(txt)
If Left(txt(i), 1) = "[" Then
If txt(i) = "[Abc]" Then
disable = True
Else
disable = False
End If
End If
If disable Then txt(i) = ";" & txt(i)
Next
fso.OpenTextFile(filename, 2).Write Join(txt, vbNewLine)
Try this
Option Explicit
Dim FSO ' Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim ReadTxtFile, WriteTxtFile ' Object
Dim TextLine, TextLineToWrite ' String
Dim AddStr' bool
' Open both text file in the same time
Set ReadTextFile = FSO.OpenTextFile("Sam.txt", 1) ' Open file to read
Set WriteTextFile = FSO.OpenTextFile("Sam_new.txt", 2, True) ' Open file to write
' Do read file as normal but add a switch
' Write original text line to text file while switch is disabled
' Add str to the text line and write once switch is trigger
AddStr = False ' Add str disabled
Do Until ReadTextFile.AtEndOfStream ' Start Read
Textline = ReadTextFile.Readline
If AddStr = True Then ' If add str enabled
TextLineToWrite = ";" & Textline ' Add string
Else ' if add str disabled
TextLineToWrite = Textline ' write original line
End If
If Trim(Textline) = "[ABC]" Then ' If indicator read
AddStr = True ' add str write
End if
WriteTextFile.WriteLine TextLineToWrite ' Write file when each line is read
Loop
ReadTextFile.Close
WriteTextFile.Close
msgbox "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) }
I am trying to loop a folder full of .html files and add some code at the beginning of the files (although I am getting some unwanted line breaks before the code I am inserting) and also to grab the contents of the <title> tag and use this for the renaming each file.
I am replacing the spaces and unwanted characters with -'s
All of this works but I am also trying to rename the existing file (Default0010.html is one example) to the text from the <title>.
This works too but when I am trying to move the existing file to the new file I get a Bad File name or Number but when I explicilty set the destination file name to a simple string it works.
It makes me thing my string is not clean or you cannot use a variable for the destination.
Also please ignore the lines Dim i, i = i + 1 and If i=1 Then Exit For.
This was added whilst I test the script then when I was happy it does what I wanted I would run it on all the HTML files.
Set objFso = CreateObject("Scripting.FileSystemObject")
Set Folder = objFSO.GetFolder("C:\My Web Sites\test\www.test.org.uk\html")
Dim i
Dim ObjFsoFile
Dim ObjFile
Dim StrData
Dim StrTitleTag
Dim OldFilename
Dim NewFilename
Set ObjFsoFile = CreateObject("Scripting.FileSystemObject")
'Loop all of the files
For Each File In Folder.Files
'Get contents of the file and store in a string
'Opening the file in READ mode
Set ObjFile = ObjFsoFile.OpenTextFile(File.Name)
'Reading from the file
StrData = ObjFile.ReadAll
'Add the Perch include to the beginning
StrData = replace(StrData,"<?php include('cms/runtime.php');?>","") 'Remove the Perch include in-case we are re-running this
StrData = replace(StrData,"<!DOCTYPE HTML PUBLIC " & Chr(34) & "-//W3C//DTD HTML 4.0 Transitional//EN" & Chr(34) & ">","<?php include('cms/runtime.php');?>" & vbcrlf & "<!DOCTYPE HTML PUBLIC " & Chr(34) & "-//W3C//DTD HTML 4.0 Transitional//EN" & Chr(34) & ">")
'Msgbox StrData
'Closing the file
ObjFile.Close
'Write the changes to the current file
Set objFile = objFSO.CreateTextFile(File.Name,True)
objFile.Write StrData
objFile.Close
'Re-write the contents of the current file and replace with the StrData Above
'Grab the contents between <title> and </title>
parse_string1 = StrData 'see above post
parse_string1 = replace(parse_string1,"<title>","¦")
parse_string = split(parse_string1,"¦")
parse = parse_string(1)
parse_string1 = replace(parse,"</title>","¦")
parse_string = split(parse_string1,"¦")
parsed_string = parse_string(0)
StrTitleTag = parsed_string 'gives final result
'Save old filename of current file to a string
OldFilename = File.Name
'Msgbox OldFilename
'Rename current file to the above contents of between <title> and </title>
'Replace spaces with - characters in the filename.
Dim divider
divider = "-"
'Replace & with and
NewFilename = Replace((StrTitleTag & ".php"),"&","and")
'Replace triple space with single space
NewFilename = Replace(NewFilename," "," ")
'Replace double space with single space
NewFilename = Replace(NewFilename," "," ")
'Replace - with space
NewFilename = Replace(NewFilename," ",divider)
'Replace ---- with -
NewFilename = Replace(NewFilename,divider & "-" & divider,divider)
'Replace ---- with -
NewFilename = Replace(NewFilename,divider & divider & divider,divider)
'Replace ,- with -
NewFilename = Replace(NewFilename,"," & divider,divider)
'Replace LineBreaks with nothing (remove line breaks)
NewFilename = Replace(NewFilename,vbCrLf,"")
NewFilename = Replace(NewFilename,vbLf,"")
NewFilename = Replace(NewFilename,vbCr,"")
NewFilename = LCase(NewFilename)
'Msgbox NewFilename
'Loop through all files
For Each File2 In Folder.Files
'Opening the file in READ mode
Set ObjFile = ObjFsoFile.OpenTextFile(File2.Name)
'Get contents of the file and store in a string
'Reading from the file
StrData = ObjFile.ReadAll
'Closing the file
ObjFile.Close
'Replace all occurences of the old filename with the new filename
StrData = Replace(StrData, OldFilename, NewFilename)
'How to write file
Set objFile = objFSO.CreateTextFile(File2.Name,True)
objFile.Write StrData
objFile.Close
Next
'Rename Old file with the new filename
If objFso.FileExists("C:\My Web Sites\test\www.test.org.uk\html\" & OldFilename) Then
'NewFileName = "test.php"
'NewFileName = "test-test-test-test-test-test-test-test-test.php"
Msgbox "Renaming the file " & OldFilename & " (Length: " & Len(OldFilename) & ") with the following name: " & NewFilename & " (Length: " & Len(NewFilename) & ")"
Msgbox "Compare: test-test-test-test-test-test-test-test-test.php " & NewFilename
objFso.MoveFile "C:\My Web Sites\test\www.test.org.uk\html\" & OldFilename, "C:\My Web Sites\test\www.test.org.uk\html\" & NewFileName
End If
i = i + 1
If i=1 Then Exit For
Next
Don't replace known bad characters. Replace everything that is not a known good character, e.g. by using a regular expression:
Set re = New RegExp
re.Pattern = "[^a-z0-9+._-]+"
re.Global = True
re.IgnoreCase = True
NewFilename = re.Replace(OldFilename, "_")
The underscore (_) usually is a safe character for this kind of replacement.
Also, don't try to manually parse elements from an HTML file unless you have to. In your case the title can be extracted far easier, like this:
Set html = CreateObject("HTMLFile")
html.Write objFso.OpenTextFile(File.Name).ReadAll
title = html.Title
It will even collapse and trim whitespace for you.
And a file can be renamed by simply changing its Name property when you already have a handle to that file:
objFile.Name = NewFilename
Simplified version of your script (without those parts that modify the content of the files):
Set fso = CreateObject("Scripting.FileSystemObject")
htmlFolder = "C:\My Web Sites\test\www.test.org.uk\html"
Set re = New RegExp
re.Pattern = "[^a-z0-9+._-]+"
re.Global = True
re.IgnoreCase = True
For Each f In objFso.GetFolder(htmlFolder).Files
data = f.OpenAsTextStream.ReadAll
Set html = CreateObject("HTMLFile")
html.Write data
oldname = f.Name
newname = re.Replace(f.Name, "_")
f.Name = newname
Next
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 = ""