Split text fiel searching for specific string of text and saving in mutltiple directories

Question

I have a text file that I need to split according to values in the 4th column of information. The script would need to split the lines of text according the the value of the fir

Answer 1

Use a dictionary to store the discriminating digits (keys) and the corresponding (open) files (values). Loop over the lines of the input file; for each line: cut the digit, write the line to 'the file for the digit'. Don't forget to close all files.

In code:

  Const csDir = "..\data\splits"
  Const csInN = "splits.txt"
  Const csInF = "..\data\splits.txt" ' should be: Const csInF = goFS.BuildPath(csDir, csInN)
  Const cnPos = 47
  Dim aSplits   : aSplits       = Array("12", "456")
  Dim dicSplits : Set dicSplits = CreateObject("Scripting.Dictionary")

  If goFS.FolderExists(csDir) Then goFS.DeleteFolder csDir
  goFS.CreateFolder csDir
  Dim nSplit
  For nSplit = 0 To UBound(aSplits)
      Dim sDir : sDir = aSplits(nSplit)
      Dim nPos
      For nPos = 1 To Len(sDir)
          dicSplits(Mid(sDir, nPos, 1)) = nSplit
      Next
      sDir = goFS.BuildPath(csDir, sDir)
      goFS.CreateFolder sDir
      Set aSplits(nSplit) = goFS.CreateTextFile(goFS.BuildPath(sDir, csInN))
  Next

  Dim tsIn : Set tsIn = goFS.OpenTextFile(csInF)
  Do Until tsIn.AtEndOfStream
      Dim sLine : sLine = tsIn.ReadLine()
      Dim sKey  : sKey  = Mid(sLine, cnPos, 1)
      If dicSplits.Exists(sKey) Then
         aSplits(dicSplits(sKey)).WriteLine sLine
      End If
  Loop
  tsIn.Close

  For nSplit = 0 To UBound(aSplits)
      aSplits(nSplit).Close
  Next

Answer 2

I'd suggest to do the discrimination with a Select statement, because I consider that a lot easier to understand. A dictionary I'd use to manage the output files.

Const ForReading     = 1
Const ForWriting     = 2
Const keyPos         = 47
Const inputFileName  = "input.txt"
Const outputFileName = "input.txt"

outputFolders = Array("foo", "bar")

Sub WriteOutput(data, fldr)
  If Not fso.FolderExists(fldr) Then fso.CreateFolder(fldr)
  If Not outputFiles.Exists(fldr) Then outputFiles.Add fldr, fso.OpenTextFile(fso.BuildPath(fldr, outputFileName), ForWriting, True)
  outputFiles(fldr).WriteLine data
End Sub

Set fso = CreateObject("Scripting.FileSystemObject")
Set outputFiles = CreateObject("Scripting.Dictionary")

Set inputFile = fso.OpenTextFile(inputFileName, ForReading, True)
Do Until inputFile.AtEndOfStream
  line = inputFile.ReadLine
  Select Case Mid(line, keyPos, 1)
  Case 1, 2:
    WriteOutput line, outputFolders(0)
  Case 4, 5, 6:
    WriteOutput line, outputFolders(1)
  End Select
Loop
inputFile.Close

For Each f In outputFiles.Items
  f.Close
Next