VBScript to loop through all files in a folder

Question

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

Answer 1

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

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

Answer 2

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:

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

  Set objFile = f.OpenAsTextStream(ForWriting)
  objFile.Write strText
  objFile.Close
Next

Answer 3

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

Answer 4

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