Reformat, delete some text, add timestamp .txt file with VBscript

I have a have a text file that I need to reformat into a single line, deleting some text and inserting the current date as the first text on the single line and comma separated.

*BEFORE FORMATING*

SHIFT  1 STARTING VALUES      8263      8181    4051   61.06   0.00  74.11
         ENDING VALUES        7230      7158    5084   54.59   0.00  74.08
         DELIVERY VALUE          0
         TOTALS



*AFTER FORMATING*

09/29/2007,8263,8181,4051,61.06,0.00,74.11,7230,7158,5084,54.59,0.00,74.08

link to unformated file -> http://mastersofsource.com/mark/regular.txt

mweidnerAsked:
Who is Participating?
 
Patrick MatthewsCommented:
THis appears to be working now:


Dim fso, ts, lin, Result1, Result2, Result3, arr

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile("c:\Test.txt")

Do Until ts.AtEndOfStream
    lin = ts.ReadLine
    If Left(lin, 5) = "SHIFT" Then
        arr = Split(lin, "VALUES")
        Result1 = FormatDateTime(Date, vbGeneralDate) & ","
        arr(1) = Trim(arr(1))
        Do Until InStr(1, arr(1), "  ") = 0
            arr(1) = Replace(arr(1), "  ", " ")
        Loop
        Result1 = Result1 & Replace(arr(1), " ", ",")
    ElseIf Left(Trim(lin), 6) = "ENDING" Then
        arr = Split(lin, "VALUES")
        arr(1) = Trim(arr(1))
        Do Until InStr(1, arr(1), "  ") = 0
            arr(1) = Replace(arr(1), "  ", " ")
        Loop
        Result2 = Result2 & Replace(arr(1), " ", ",")
    ElseIf Left(Trim(lin), 8) = "DELIVERY" Then
        Result3 = Trim(Split(lin, "VALUE")(1))
    End If
Loop
ts.Close

Set ts = fso.CreateTextFile("c:\Results.txt", True)
ts.WriteLine Result1 & "," & Result2 & "," & Result3
ts.Close

Set ts = Nothing
Set fso = Nothing
0
 
KragsterCommented:
question:  Are the words at the start of each line always the same, i mean, will it always say "SHIFT 1 STARTING VALUES " before the numbers you want?  and same for the other two lines.
0
 
cupCommented:
The basic gist is

create an empty list
while not end of file
   read a line
   split the line using space as a delimiter and assign the result to numbers
   note end position in list
   for each number
       if numeric then
           add number to list
       else
           reset to saved end position
   next
loop
print the date
print comma followed by each number until you reach the penultimate number in the list
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
mweidnerAuthor Commented:
Words always the same, numbers change.

example of another file, only the number changed.

SHIFT  1 STARTING VALUES      2344      2321    5834   31.58   0.00  73.65
         ENDING VALUES        2187      2167    5991   30.03   0.00  72.80
         DELIVERY VALUE          0
         TOTALS
0
 
mweidnerAuthor Commented:
"Totals" does have a number if there is a delivery but that line needs stripped anyway, not used.
0
 
Patrick MatthewsCommented:
Dim fso, ts, lin, Result1, Result2, arr

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile("c:\folder\subfolder\file.txt")

Do Until ts.AtEndOfStream
    lin = ts.ReadLine
    If Left(lin, 5) = "SHIFT" Then
        arr = Split(lin, "VALUES")
        Result1 = FormatDateTime(Now, vbGeneralDate) & ","
        arr(1) = Trim(arr(1))
        Do Until InStr(1, arr(1), "  ") = 0
            Replace(arr(1), "  ", " ")
        Loop
        Result1 = Result1 & Replace(arr(1), " ", ",")
    ElseIf Left(Trim(lin), 6) = "ENDING" Then
        arr = Split(lin, "VALUES")
        arr(1) = Trim(arr(1))
        Do Until InStr(1, arr(1), "  ") = 0
            Replace(arr(1), "  ", " ")
        Loop
        Result2 = Result2 & Replace(arr(1), " ", ",")
    End If
Loop
ts.Close

Set ts = fso.CreateTextFile("c:\folder\subfolder\results.txt", True)
ts.WriteLine Result1 & "," & Result2
ts.Close

Set ts = Nothing
Set fso = Nothing
0
 
mweidnerAuthor Commented:
Oops, that single line in my first post samole should have a zero on the end, the "Delivery Value" number.
0
 
Patrick MatthewsCommented:
Dim fso, ts, lin, Result1, Result2, Result3, arr

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile("c:\folder\subfolder\file.txt")

Do Until ts.AtEndOfStream
    lin = ts.ReadLine
    If Left(lin, 5) = "SHIFT" Then
        arr = Split(lin, "VALUES")
        Result1 = FormatDateTime(Now, vbGeneralDate) & ","
        arr(1) = Trim(arr(1))
        Do Until InStr(1, arr(1), "  ") = 0
            Replace(arr(1), "  ", " ")
        Loop
        Result1 = Result1 & Replace(arr(1), " ", ",")
    ElseIf Left(Trim(lin), 6) = "ENDING" Then
        arr = Split(lin, "VALUES")
        arr(1) = Trim(arr(1))
        Do Until InStr(1, arr(1), "  ") = 0
            Replace(arr(1), "  ", " ")
        Loop
        Result2 = Result2 & Replace(arr(1), " ", ",")
    ElseIf Left(Trim(lin), 8) = "DELIVERY" Then
        Result3 = Trim(Split(lin, "VALUE"))
    End If
Loop
ts.Close

Set ts = fso.CreateTextFile("c:\folder\subfolder\results.txt", True)
ts.WriteLine Result1 & "," & Result2 & "," & Result3
ts.Close

Set ts = Nothing
Set fso = Nothing
0
 
mweidnerAuthor Commented:
Matthewspatrick:

line 13
char 26
cannot use parentheses when calling a Sub
0
 
mweidnerAuthor Commented:
Sure does, so I have 4 of these files, should I run the script 4 times or can the code be changed easy enough?  The files are regular.txt plus.txt super.txt kero.txt in c:\rubyfiles\tanks\   No other files are in that directory.
0
 
Patrick MatthewsCommented:
mweidner,

It would be easy to modify the script to process all files in the directory, but it will be a few hours
before I can get around to it.

Regards,

Patrick
0
 
Patrick MatthewsCommented:
Dim fso, ts, lin, Result1, Result2, Result3, arr, fld, fil, ts2

Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("c:\rubyfiles\tanks")
Set ts2 = fso.CreateTextFIle("c:\results.txt")

For Each fil In fld.Folders
    Set ts = fso.OpenTextFile(fil.Path)
    Do Until ts.AtEndOfStream
        lin = ts.ReadLine
        If Left(lin, 5) = "SHIFT" Then
            arr = Split(lin, "VALUES")
            Result1 = FormatDateTime(Date, vbGeneralDate) & ","
            arr(1) = Trim(arr(1))
            Do Until InStr(1, arr(1), "  ") = 0
                arr(1) = Replace(arr(1), "  ", " ")
            Loop
            Result1 = Result1 & Replace(arr(1), " ", ",")
        ElseIf Left(Trim(lin), 6) = "ENDING" Then
            arr = Split(lin, "VALUES")
            arr(1) = Trim(arr(1))
            Do Until InStr(1, arr(1), "  ") = 0
                arr(1) = Replace(arr(1), "  ", " ")
            Loop
            Result2 = Result2 & Replace(arr(1), " ", ",")
        ElseIf Left(Trim(lin), 8) = "DELIVERY" Then
            Result3 = Trim(Split(lin, "VALUE")(1))
        End If
    Loop
    ts.Close
    ts2.WriteLine Result1 & "," & Result2 & "," & Result3
Next

ts2.Close

Set fil = Nothing
Set fld = Nothing
Set ts = Nothing
Set ts2 = Nothing
Set fso = Nothing
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.