Reformatting text II ....

Hi.

I would like to use vbscript to reformat text in a musiclibrary.
I allready got good help in building a part of the script.
(Thanks very much to Tom Ogilvy and Helmut Weber...)

Short explanation:

1. Reading a textfile - line by line:

Could be done with the script:

Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile _
("c:\composer.txt", ForReading)
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
arrServiceList = Split(strNextLine , vbNewLine)
'Wscript.Echo arrServiceList(0)
For i = 1 to Ubound(arrServiceList)
' Wscript.Echo arrServiceList(i)
Next
Loop



2. Reformat the text in each line by the script:


Dim s 'the text in variable s should be replaced by the text from line 1 in
the textfile.
s = "ADAMS, BRYAN (ENG) + " & "DENVER, JOHN (USA) + JARRE, " & "JEAN
MICHELLE (FRA) + " & "THE BEATLES + THE DOORS"
wscript.echo(SwitchOrder(s))

Public Function SwitchOrder(s)
Dim v,s1,s2,s3,s4,s5,iloc,iloc1
v = Split(s, "+")
For i = LBound(v) To UBound(v)
s1 = Trim(v(i))
iloc = InStr(1, s1, "(", vbTextCompare)
If iloc <> 0 Then
s5 = Trim(Right(s1, Len(s1) - iloc + 1))
s2 = Left(s1, iloc - 1)
iloc1 = InStr(1, s2, ",", vbTextCompare)
s3 = Trim(Left(s2, iloc1 - 1))
s4 = Trim(Right(s2, Len(s2) - iloc1))
s4 = s4 & " " & s3 & " " & s5
v(i) = s4
End If
Next
SwitchOrder = Join(v, " + ")

End Function


3. Write the result into a new textfile



*****Example of a textfile:

DENVER, JOHN (USA) + MOORE, ROGER (USA)
THE BEATLES + STEWART, ROD
...
....
.....


I'm having problem with combining all my information to form the total
script.
Any experts who can answer ?

Best regards
\T.Tei

James
Sun Sep 17 09:36:13 CDT 2006


Titten Tei wrote:

> 1. Reading a textfile - line by line:
>
> Could be done with the script:
>
> Const ForReading = 1
> Set objFSO = CreateObject("Scripting.FileSystemObject")
> Set objTextFile = objFSO.OpenTextFile _
> ("c:\composer.txt", ForReading)
> Do Until objTextFile.AtEndOfStream
> strNextLine = objTextFile.Readline
> arrServiceList = Split(strNextLine , vbNewLine)

You're already reading the current line into strNextLine...the
arrServiceList array is splitting on the vbNewLine character which is
unnecessary since the work is already done with the ReadLine method.


Titten,
I've modified the script slightly. In your previous post you also
mentioned that you wanted the text to be in proper case. Here is a
solution based on the SwitchOrder function that Tom & Helmut posted.
I've added a ProperCase function that you can pass a phrase or word to
and it will return the same phrase in proper case. Also added is my
LogIt function which will write a line of text to the text file you
specify.

On the first line of this script the FixMusicLib sub routine is called.
You must specify the input file, and the output file on this line.


---------------------
FixMusicLib "C:\composer.txt","C:\newlib.txt"

Sub FixMusicLib(strInFile, strOutFile)
Dim s
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile _
(strInFile, ForReading)
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
'writes the newly formatted line to your strOutFile
LogIt strOutFile,SwitchOrder(strNextLine)
Loop
End Sub


Public Function SwitchOrder(s)
Dim v,s1,s2,s3,s4,s5,iloc,iloc1
v = Split(s, "+")
For i = LBound(v) To UBound(v)
s1 = Trim(v(i))
iloc = InStr(1, s1, "(", vbTextCompare)
If iloc <> 0 Then
s5 = Trim(Right(s1, Len(s1) - iloc + 1))
s2 = Left(s1, iloc - 1)
iloc1 = InStr(1, s2, ",", vbTextCompare)
s3 = ProperCase(Trim(Left(s2, iloc1 - 1)))
s4 = ProperCase(Trim(Right(s2, Len(s2) - iloc1)))
s4 = s4 & " " & s3 & " " & s5
v(i) = s4
Else
v(i) = ProperCase(s1)
End If
Next
SwitchOrder = Join(v, " + ")
End Function


Function ProperCase(strPhrase)
'Accepts a phrase as a String
'Returns the same phrase in ProperCase
Dim intLength, strFirst, strTheRest, i
If InStr(1,strPhrase," ") <> 0 Then
arrWords = Split(strPhrase," ")
For i = 0 To UBound(arrWords)
intLength = Len(arrWords(i))
strFirst = UCase(Left(arrWords(i),1))
strTheRest = Trim(LCase(Right(arrWords(i),intLength -1)))
ProperCase = ProperCase & " " & strFirst & strTheRest
Next
Else
intLength = Len(strPhrase)
strFirst = UCase(Left(strPhrase, 1))
strTheRest = Trim(LCase(Right(strPhrase, intLength - 1)))
ProperCase = strFirst & strTheRest
End If
End Function


Function LogIt(strLogFile,strLine)
'Accepts a log file name and a line of text as strings
'Creates the log file if it doesn't exist and appends
'the line of text to the file
'Returns TRUE if writing line to file was successful,
'FALSE otherwise
Dim fso, file
Const ForAppending = 8
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strLogFile) = False Then
Set file = fso.CreateTextFile(strLogFile)
Else
Set file = fso.OpenTextFile(strLogFile,ForAppending)
End If
If Err.Number = 0 Then
file.WriteLine(strLine)
file.Close
LogIt = True
Else
LogIt = False
End If
End Function

---------------------

--
James Garringer