VBScript to loop through all files in a folder

I have the code to carry out the process on a single file, could anyone alter this script so it loops through all files in the directory "H:\Letter Display\Letters" with the file type "*.LTR*" and saves them all:

Const ForReading = 1
Const ForWriting = 2

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("H:\Letter Display\Letters\LTRPRT__00000008720000000001NI-K-RMND.LTR", ForReading)


str1000 = "1000"
str1100 = "1100"
str1200 = "1200"
str9990 = "9990"

arrCommas1 = Array(14,31,41,59,70,81,101,111,124,138)
arrCommas2 = Array(14,31,41,55,79,144,209,274,409,563,589,608,623)
arrCommas3 = ArraY (14,32,41,73,83,97,106,156,167,184,188,195,207,260,273,332,368,431,461,472,593,617,666,772,810,834,848,894,898)
arrCommas4 = Array(14,31,41)

Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine

If Left(strLine, 4) = str1000 then
intLength = Len(strLine)
For Each strComma in arrCommas1
strLine = Left(strLine, strComma - 1) + "," _
+ Mid(strLine, strComma, intLength)
Next
End If

If Left(strLine, 4) = str1100 then
intLength = Len(strLine)
For Each strComma in arrCommas2
strLine = Left(strLine, strComma - 1) + "," _
+ Mid(strLine, strComma, intLength)
Next
End If

If Left(strLine, 4) = str1200 then
intLength = Len(strLine)
For Each strComma in arrCommas3
strLine = Left(strLine, strComma - 1) + "," _
+ Mid(strLine, strComma, intLength)
Next
End If

If Left(strLine, 4) = str9990 then
intLength = Len(strLine)
For Each strComma in arrCommas4
strLine = Left(strLine, strComma - 1) + "," _
+ Mid(strLine, strComma, intLength)
Next
End If

strText = strText & strLine & vbCrLf
Loop


objFile.Close

Set objFile = objFSO.OpenTextFile("H:\Letter Display\Letters\LTRPRT__00000008720000000001NI-K-RMND.LTR", ForWriting)
objFile.Write strText
objFile.Close

Any help would be much appreciated!

Thanks

What would be even better is to do a recursive function to go into all folders that are below your main folder and search those as well.. Just and idea :)

Maybe this will clear things up. (Or confuse you more, <g>)

Const ForReading = 1
Const ForWriting = 2

sFolder = "H:\Letter Display\Letters\"
Set oFSO = CreateObject("Scripting.FileSystemObject")

For Each oFile In oFSO.GetFolder(sFolder).Files
If UCase(oFSO.GetExtensionName(oFile.Name)) = "LTR" Then
ProcessFiles oFSO, oFile
End if
Next

Set oFSO = Nothing


Sub ProcessFiles(FSO, File)

Set oFile2 = FSO.OpenTextFile(File.path, ForReading)

str1000 = "1000"
str1100 = "1100"
str1200 = "1200"
str9990 = "9990"

arrCommas1 = Array(14,31,41,59,70,81,101,111,124,138)
arrCommas2 = Array(14,31,41,55,79,144,209,274,409,563,589,608,623)
arrCommas3 = ArraY (14,32,41,73,83,97,106,156,167,184,188,195,207,260,273,332,368,431,461,472,593,617,666,772,810,834,848,894,898)
arrCommas4 = Array(14,31,41)

Do Until oFile2.AtEndOfStream
strLine = oFile2.ReadLine

If Left(strLine, 4) = str1000 then
intLength = Len(strLine)
For Each strComma in arrCommas1
strLine = Left(strLine, strComma - 1) + "," _
+ Mid(strLine, strComma, intLength)
Next
End If

If Left(strLine, 4) = str1100 then
intLength = Len(strLine)
For Each strComma in arrCommas2
strLine = Left(strLine, strComma - 1) + "," _
+ Mid(strLine, strComma, intLength)
Next
End If

If Left(strLine, 4) = str1200 then
intLength = Len(strLine)
For Each strComma in arrCommas3
strLine = Left(strLine, strComma - 1) + "," _
+ Mid(strLine, strComma, intLength)
Next
End If

If Left(strLine, 4) = str9990 then
intLength = Len(strLine)
For Each strComma in arrCommas4
strLine = Left(strLine, strComma - 1) + "," _
+ Mid(strLine, strComma, intLength)
Next
End If

strText = strText & strLine & vbCrLf
Loop

sFile = File.path
oFile2.close
set oFile2 = Nothing

Set File = FSO.OpenTextFile(sFile , ForWriting)
File.Write strText
File.Close
Set File = Nothing

end sub

Your current script basically does the following:

Set objFile = objFSO.OpenTextFile("...", ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
'do stuff with strLine and append to strText
Loop
objFile.Close

Set objFile = objFSO.OpenTextFile("...", ForWriting)
objFile.Write strText
objFile.Close

For processing all files in a given folder you just need to add an outer loop around that, and adjust some instructions accordingly:

<pre><code><b>For Each f In objFSO.GetFolder("C:\some\folder").Files</b>
Set objFile = <b>f.OpenAsTextStream</b>
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
'do stuff with strLine and append to strText
Loop
objFile.Close

Set objFile = <b>f.OpenAsTextStream(ForWriting)</b>
objFile.Write strText
objFile.Close
<b>Next</b></code></pre>

This doesn't address your exact scenario because without seeing the files I'm not sure what all those arrays and logic are for if you just need to do simple string replacements, but code I have below would take the files in a given directory, edit them with a couple of example string replacements, and then save them. You would save the following as `H:\Letter Display\FixLTRFiles.vbs` and run it:

Option Explicit

Dim FSO, FLD, FIL, TS
Dim strFolder, strContent, strPath
Const ForReading = 1, ForWriting = 2, ForAppending = 8

'Change as needed - this names a folder at the same location as this script
strFolder = "Letters"

'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.Name
If UCase(FSO.GetExtensionName(Fil.Name)) = "LTR" Then

'Open the file to read
Set TS = FSO.OpenTextFile(Fil.Path, ForReading)
'Read the contents into a variable
strContent = TS.ReadAll
'Close the file
TS.Close

'Replace the errant strings
IF INSTR(strContent,"SomeContentToReplace")>0 THEN
strContent = Replace(strContent, "SomeContentToReplace", "MyNewContent")
END IF
IF INSTR(strContent,"MoreContentToReplace")>0 THEN
strContent = Replace(strContent, "MoreContentToReplace", "MyOtherNewContent")
END IF

'Open the file to overwrite the contents
Set TS = FSO.OpenTextFile(Fil.Path, ForWriting)
'Write the contents back
TS.Write strContent
'Close the current file
TS.Close

End If
Next


'Clean up
Set TS = Nothing
Set FLD = Nothing
Set FSO = Nothing

MsgBox "Done!"