VB Script: retrieve level2.level3 and generated multiple files based on values of column A

Hello experts,

I have the following file.csv which contains the following:

Organization;ID;Name
Tinder.porter.tirter.toto.type;58585;name1
Tinder.porter.tata.toto.tetetati.;58585;name2
Tinder.porter.tata.toto.tetetatu.;58585;name2

I need an script that do the following:

Create a file2_revised.csv by keeping just level2.level3 of Organization (warning: Organization can contains multiple levels).
Create multiple files based on and filter by Organization of file2_revised

Example after I launch the script:

Files2_revised.csv has been created with the following information:

Organization;ID;Name
porter.tirter;58585;name1
porter.tata;58585;name2
porter.tata;58585;name3

and Two additional files

porter.tirter.csv with the following information

Organization;ID;Name;
porter.tirter;58585;name1


porter.tata.csv with the following information

Organization;ID;Name;
porter.tata;58585;name2
porter.tata;58585;name3

Log loop requirements:

If folder of file.csv doesn’t exist logouput = Now variablefolder doesn’t exist.
If file.csv doesn’t exist logouput = Now file doesn’t exist doesn’t exist.
If folder path doesn’t finish with ‘\’ add ‘\'
Log file name = “log-file-split”
File name should be generated at : objFSO.GetAbsolutePathName(".")

Thank you in advance for your help!
LVL 1
LD16Asked:
Who is Participating?
 
Bill PrewCommented:
Okay, I think this has accounted for all the changes you required now, and tested here.

' Text file I/O constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

'Create the file system object for creating folders:
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Define folders and files to work with
strScriptDir = objFSO.GetAbsolutePathName(".")
strBaseDir = "C:\Users\SESA249410\Desktop\Scripts-revised\test\folder\spot-mstt-match-multiple-generationa"
strFileIn = strBaseDir & "\test.csv"
strLogFile = strScriptDir & "\log-file-split.txt"

' Open log file for appending
Set objLog = objFSO.OpenTextFile(strLogFile, ForAppending, True)

' Make sure input folder exists
If Not objFSO.FolderExists(strBaseDir) Then
   objLog.WriteLine Now & " ERROR: Input folder """ & strBaseDir & """ does not exist."
   Wscript.Quit
End If

' Make sure input file exists
If Not objFSO.FileExists(strFileIn) Then
   objLog.WriteLine Now & " ERROR: Input file """ & strFileIn & """ does not exist."
   Wscript.Quit
End If

' Read entire input file into an array
Set objFileIn = objFSO.OpenTextFile(strFileIn, ForReading, False, TriStateUseDefault)
arrLines = Split(objFileIn.ReadAll, VbCrLf)
objFileIn.Close
Set objFileIn = Nothing

' Process all lines from input file
For i = LBound(arrLines) To UBound(arrLines)

   ' Skip blank lines in input file
   If arrLines(i) <> "" Then

      ' If header line just write it out
      If i = LBound(arrLines) Then
         strHeader = arrLines(i)
      Else
         ' Process data line
         arrFields = Split(arrLines(i), ";")
         ' Write to individual file for just this ORG
         WriteOrgFile arrFields(0), arrLines(i)
      End If

   End If

Next

' Wrap up
objLog.Close


' Subroutine to add a row to the individual file for the ORG
Sub WriteOrgFile(strOrg, strLine)
   ' Build name for this ORG file from data in ORG field (node2.node3)
   strFileOrg = strBaseDir & "\" & strOrg & ".csv"

   ' If the file doesn't exist yet we need the header line
   If objFSO.FileExists(strFileOrg) Then 
      blnNeedHeader = False
   Else 
      blnNeedHeader = True
   End If

   ' Open this file for apending
   Set objFileOrg = objFSO.OpenTextFile(strFileOrg, ForAppending, True)

   ' Write header line of needed
   If blnNeedHeader Then
      objFileOrg.WriteLine strHeader
   End If

   ' Write data line
   objFileOrg.WriteLine strLine
End Sub

Open in new window

~bp
0
 
Bill PrewCommented:
Is the file sorted by level 2.level 3, so all the lines with the same level2 and level 3 will be grouped together?  Or could they be spread apart in the file, like:

Tinder.porter.tata.toto.tetetati.;58585;name2
Tinder.porter.tirter.toto.type;58585;name1
Tinder.porter.tata.toto.tetetatu.;58585;name2

or

Tinder.porter.tirter.toto.type;58585;name1
Tinder.porter.tata.toto.tetetati.;58585;name2
Tinder.porter.tata.toto.tetetatu.;58585;name2
Sinder.porter.tirter.toto.type;58585;name1
Sinder.porter.tata.toto.tetetati.;58585;name2
Sinder.porter.tata.toto.tetetatu.;58585;name2

~bp
0
 
LD16Author Commented:
Hello Bill,

Thank you for your feedback, the lines in Files2_revised.csv can be spread apart.
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
Bill PrewCommented:
Okay, give this a try, should do the job.

Note though, that it appends to the individual files names with the ORG in their name (like porter.tirter.csv), so if you run this more than once in the same folder with the same data you will want to delete the files from the prior run.

Adjust strBaseDir as needed.

' Text file I/O constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

'Create the file system object for creating folders:
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Define folders and files to work with
strScriptDir = objFSO.GetAbsolutePathName(".")
strBaseDir = "B:\EE\EE28634944"
strFileIn = strBaseDir & "\file.csv"
strFileOut = strBaseDir & "\files2_revised.csv"
strLogFile = strScriptDir & "\log-file-split.txt"

' Open log file for appending
Set objLog = objFSO.OpenTextFile(strLogFile, ForAppending, True)

' Make sure input folder exists
If Not objFSO.FolderExists(strBaseDir) Then
   objLog.WriteLine Now & " ERROR: Input folder """ & strBaseDir & """ does not exist."
   Wscript.Quit
End If

' Make sure input file exists
If Not objFSO.FileExists(strFileIn) Then
   objLog.WriteLine Now & " ERROR: Input file """ & strFileIn & """ does not exist."
   Wscript.Quit
End If

' Read entire input file into an array
Set objFileIn = objFSO.OpenTextFile(strFileIn, ForReading, False, TriStateUseDefault)
arrLines = Split(objFileIn.ReadAll, VbCrLf)
objFileIn.Close
Set objFileIn = Nothing

' Open new output file
Set objFileOut = objFSO.OpenTextFile(strFileOut, ForWriting, True)

' Process all lines from input file
For i = LBound(arrLines) To UBound(arrLines)

   ' Skip blank lines in input file
   If arrLines(i) <> "" Then

      ' If header line just write it out
      If i = LBound(arrLines) Then
         strHeader = arrLines(i)
         objFileOut.WriteLine strHeader
      Else
         ' Process data line
         arrFields = Split(arrLines(i), ";")
         If UBound(arrFields) = 2 Then
            arrOrg = Split(arrFields(0), ".")
            If UBound(arrOrg) > 1 Then
               ' Change ORG to just node2.node3
               arrFields(0) = arrOrg(1) & "." & arrOrg(2)
               ' Write to new file of all Data
               objFileOut.WriteLine Join(arrFields, ";")
               ' Write to individual file for just this ORG
               WriteOrgFile arrFields
            Else
               ' WARNING (too few nodes in ORG)
               objLog.WriteLine Now & " WARNING: Processing line """ & i+1 & """, too few nodes in ORG field """ & arrFields(0) & """."
            End If
         Else
            ' WARNING (not 3 fields in data line)
            objLog.WriteLine Now & " WARNING: Processing line """ & i+1 & """, found """ & UBound(arrFields)+1 & """ fields, must be 3."
         End If
      End If

   End If

Next

' Wrap up
objFileOut.Close
objLog.Close


' Subroutine to add a row to the individual file for the ORG
Sub WriteOrgFile(arrFields())
   ' Build name for this ORG file from data in ORG field (node2.node3)
   strFileOrg = strBaseDir & "\" & arrFields(0) & ".csv"

   ' If the file doesn't exist yet we need the header line
   If objFSO.FileExists(strFileOrg) Then 
      blnNeedHeader = False
   Else 
      blnNeedHeader = True
   End If

   ' Open this file for apending
   Set objFileOrg = objFSO.OpenTextFile(strFileOrg, ForAppending, True)

   ' Write header line of needed
   If blnNeedHeader Then
      objFileOrg.WriteLine strHeader
   End If

   ' Write data line
   objFileOrg.WriteLine Join(arrFields, ";")
End Sub

Open in new window

~bp
0
 
LD16Author Commented:
Thank you so much. I will test it on Monday as I don't have Windows at home.
0
 
LD16Author Commented:
Hello Bill,

Thank you for this script.
I just realized that I don't need to keep just level2 & level3 as A I am already able to recover this information through another sql query.

So could you please help me to simplify the code ID: 40663827 in order to just split the data based on values of column A?
Sorry for this and thank you again for your help.
0
 
LD16Author Commented:
New specs requirements:

Open file1.csv
Generate each files based on the value of Column A

Log requirement of the previous file can be kept.

Thank you and sorry for this change.
0
 
Bill PrewCommented:
Give this a try - untested.

' Text file I/O constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

'Create the file system object for creating folders:
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Define folders and files to work with
strScriptDir = objFSO.GetAbsolutePathName(".")
strBaseDir = "B:\EE\EE28634944"
strFileIn = strBaseDir & "\file.csv"
strLogFile = strScriptDir & "\log-file-split.txt"

' Open log file for appending
Set objLog = objFSO.OpenTextFile(strLogFile, ForAppending, True)

' Make sure input folder exists
If Not objFSO.FolderExists(strBaseDir) Then
   objLog.WriteLine Now & " ERROR: Input folder """ & strBaseDir & """ does not exist."
   Wscript.Quit
End If

' Make sure input file exists
If Not objFSO.FileExists(strFileIn) Then
   objLog.WriteLine Now & " ERROR: Input file """ & strFileIn & """ does not exist."
   Wscript.Quit
End If

' Read entire input file into an array
Set objFileIn = objFSO.OpenTextFile(strFileIn, ForReading, False, TriStateUseDefault)
arrLines = Split(objFileIn.ReadAll, VbCrLf)
objFileIn.Close
Set objFileIn = Nothing

' Process all lines from input file
For i = LBound(arrLines) To UBound(arrLines)

   ' Skip blank lines in input file
   If arrLines(i) <> "" Then

      ' Skip header line
      If i > LBound(arrLines) Then
         ' Process data line
         arrFields = Split(arrLines(i), ";")
         If UBound(arrFields) = 2 Then
            ' Write to individual file for just this ORG
            WriteOrgFile arrFields
         Else
            ' WARNING (not 3 fields in data line)
            objLog.WriteLine Now & " WARNING: Processing line """ & i+1 & """, found """ & UBound(arrFields)+1 & """ fields, must be 3."
         End If
      End If

   End If

Next

' Wrap up
objFileOut.Close
objLog.Close


' Subroutine to add a row to the individual file for the ORG
Sub WriteOrgFile(arrFields())
   ' Build name for this ORG file from data in ORG field (node2.node3)
   strFileOrg = strBaseDir & "\" & arrFields(0) & ".csv"

   ' If the file doesn't exist yet we need the header line
   If objFSO.FileExists(strFileOrg) Then 
      blnNeedHeader = False
   Else 
      blnNeedHeader = True
   End If

   ' Open this file for apending
   Set objFileOrg = objFSO.OpenTextFile(strFileOrg, ForAppending, True)

   ' Write header line of needed
   If blnNeedHeader Then
      objFileOrg.WriteLine strHeader
   End If

   ' Write data line
   objFileOrg.WriteLine Join(arrFields, ";")
End Sub

Open in new window

~bp
0
 
LD16Author Commented:
Hello Bill,
Thank you for this code. I will test it tomorrow.
0
 
LD16Author Commented:
Hello Bill,

Very strange. I got an error message in line 12 "Expected end of statement".
Thank you again for your help.
0
 
LD16Author Commented:
The error message concerns the code ID: 40669451, the code ID: 40663827 works perfectly.
0
 
Bill PrewCommented:
Can you post up the exact script you ran (with any changes you made), as well as a capture of the error?  I don't see anything bad about the line 12 I posted.

~bp
0
 
LD16Author Commented:
Ok, I will send you all the info tomorrow.
0
 
LD16Author Commented:
Hello,

The line 12 it was because I dind't copy properly your code I miss ' char in line 1

This is the code that I used:
' Text file I/O constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

'Create the file system object for creating folders:
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Define folders and files to work with
strScriptDir = objFSO.GetAbsolutePathName(".")
strBaseDir = "C:\Users\SESA249410\Desktop\Scripts-revised\test\folder\spot-mstt-match-multiple-generationa"
strFileIn = strBaseDir & "\test.csv"
strLogFile = strScriptDir & "\log-file-split.txt"

' Open log file for appending
Set objLog = objFSO.OpenTextFile(strLogFile, ForAppending, True)

' Make sure input folder exists
If Not objFSO.FolderExists(strBaseDir) Then
   objLog.WriteLine Now & " ERROR: Input folder """ & strBaseDir & """ does not exist."
   Wscript.Quit
End If

' Make sure input file exists
If Not objFSO.FileExists(strFileIn) Then
   objLog.WriteLine Now & " ERROR: Input file """ & strFileIn & """ does not exist."
   Wscript.Quit
End If

' Read entire input file into an array
Set objFileIn = objFSO.OpenTextFile(strFileIn, ForReading, False, TriStateUseDefault)
arrLines = Split(objFileIn.ReadAll, VbCrLf)
objFileIn.Close
Set objFileIn = Nothing

' Process all lines from input file
For i = LBound(arrLines) To UBound(arrLines)

   ' Skip blank lines in input file
   If arrLines(i) <> "" Then

      ' Skip header line
      If i > LBound(arrLines) Then
         ' Process data line
         arrFields = Split(arrLines(i), ";")
         If UBound(arrFields) = 2 Then
            ' Write to individual file for just this ORG
            WriteOrgFile arrFields
         Else
            ' WARNING (not 3 fields in data line)
            objLog.WriteLine Now & " WARNING: Processing line """ & i+1 & """, found """ & UBound(arrFields)+1 & """ fields, must be 3."
         End If
      End If

   End If

Next

' Wrap up
objFileOut.Close
objLog.Close


' Subroutine to add a row to the individual file for the ORG
Sub WriteOrgFile(arrFields())
   ' Build name for this ORG file from data in ORG field (node2.node3)
   strFileOrg = strBaseDir & "\" & arrFields(0) & ".csv"

   ' If the file doesn't exist yet we need the header line
   If objFSO.FileExists(strFileOrg) Then 
      blnNeedHeader = False
   Else 
      blnNeedHeader = True
   End If

   ' Open this file for apending
   Set objFileOrg = objFSO.OpenTextFile(strFileOrg, ForAppending, True)

   ' Write header line of needed
   If blnNeedHeader Then
      objFileOrg.WriteLine strHeader
   End If

   ' Write data line
   objFileOrg.WriteLine Join(arrFields, ";")
End Sub

Open in new window


And I got the following error message:
Capture.GIF
Another remark, in the log file I got for the various lines:
Processing line "2", found "4" fields, must be 3.
The following loop need to be removed as the values in column A should not have any restriction:
 
 If UBound(arrFields) = 2 Then
            ' Write to individual file for just this ORG
            WriteOrgFile arrFields
         Else
            ' WARNING (not 3 fields in data line)
            objLog.WriteLine Now & " WARNING: Processing line """ & i+1 & """, found """ & UBound(arrFields)+1 & """ fields, must be 3."

Open in new window


Thank you in advance for your help.
0
 
Bill PrewCommented:
Okay, to resolve the error, the line with objFileOut needs to be removed, that was a cut and paste error.

' Text file I/O constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

'Create the file system object for creating folders:
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Define folders and files to work with
strScriptDir = objFSO.GetAbsolutePathName(".")
strBaseDir = "C:\Users\SESA249410\Desktop\Scripts-revised\test\folder\spot-mstt-match-multiple-generationa"
strFileIn = strBaseDir & "\test.csv"
strLogFile = strScriptDir & "\log-file-split.txt"

' Open log file for appending
Set objLog = objFSO.OpenTextFile(strLogFile, ForAppending, True)

' Make sure input folder exists
If Not objFSO.FolderExists(strBaseDir) Then
   objLog.WriteLine Now & " ERROR: Input folder """ & strBaseDir & """ does not exist."
   Wscript.Quit
End If

' Make sure input file exists
If Not objFSO.FileExists(strFileIn) Then
   objLog.WriteLine Now & " ERROR: Input file """ & strFileIn & """ does not exist."
   Wscript.Quit
End If

' Read entire input file into an array
Set objFileIn = objFSO.OpenTextFile(strFileIn, ForReading, False, TriStateUseDefault)
arrLines = Split(objFileIn.ReadAll, VbCrLf)
objFileIn.Close
Set objFileIn = Nothing

' Process all lines from input file
For i = LBound(arrLines) To UBound(arrLines)

   ' Skip blank lines in input file
   If arrLines(i) <> "" Then

      ' Skip header line
      If i > LBound(arrLines) Then
         ' Process data line
         arrFields = Split(arrLines(i), ";")
         ' Write to individual file for just this ORG
         WriteOrgFile arrFields
      End If

   End If

Next

' Wrap up
objLog.Close


' Subroutine to add a row to the individual file for the ORG
Sub WriteOrgFile(arrFields())
   ' Build name for this ORG file from data in ORG field (node2.node3)
   strFileOrg = strBaseDir & "\" & arrFields(0) & ".csv"

   ' If the file doesn't exist yet we need the header line
   If objFSO.FileExists(strFileOrg) Then 
      blnNeedHeader = False
   Else 
      blnNeedHeader = True
   End If

   ' Open this file for apending
   Set objFileOrg = objFSO.OpenTextFile(strFileOrg, ForAppending, True)

   ' Write header line of needed
   If blnNeedHeader Then
      objFileOrg.WriteLine strHeader
   End If

   ' Write data line
   objFileOrg.WriteLine Join(arrFields, ";")
End Sub

Open in new window

~bp
0
 
LD16Author Commented:
Ok I don't get any error but I am still having the log:
Processing line "2", found "4" fields, must be 3.

Can we remove this condition as field A cannot be 3. Thank you in advance for your help.
0
 
LD16Author Commented:
Perfect! It works!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.