Change in specific position in .txt

[om-yousif]

Hello everybody

If i have two .txt files
First contains a list of words each in new line :
Similar to this
One
This
Hello
Two

Second contains a long text:
a sample part of the second file:

INPUT STRING:
LOOK-UP WORD: tnZm
SOLUTION 1: (tanaZ~ama) [tanaZ~am_1] tanaZ~am/VERB_PERFECT+a/PVSUFF_SUBJ:3MS
(GLOSS): + be organized/be regulated + he/it <verb>
SOLUTION 2: (tanoZim) [naZam-i_1] ta/IV3FS+noZim/VERB_IMPERFECT
(GLOSS): it/they/she + arrange/organize/compose +
SOLUTION 3: (tunaZ~im) [naZ~am_1] tu/IV3FS+naZ~im/VERB_IMPERFECT
(GLOSS): it/they/she + arrange/organize/regulate +

INPUT STRING:
LOOK-UP WORD: jAmEp
SOLUTION 1: (jAmiEap) [jAmiE_1] jAmiE/NOUN+ap/NSUFF_FEM_SG
(GLOSS): + comprehensive/extensive + [fem.sg.]
SOLUTION 2: (jAmiEap) [jAmiEap_1] jAmiE/NOUN+ap/NSUFF_FEM_SG
(GLOSS): + university/league + [fem.sg.]


I need to replace each word between the brackets in the second file with the words in the first file , except the word (GLOSS) will not be changed

Means that the word the second file will be changed to

INPUT STRING:
LOOK-UP WORD: tnZm
SOLUTION 1: (one) [tanaZ~am_1] tanaZ~am/VERB_PERFECT+a/PVSUFF_SUBJ:3MS
(GLOSS): + be organized/be regulated + he/it <verb>
SOLUTION 2: (this) [naZam-i_1] ta/IV3FS+noZim/VERB_IMPERFECT
(GLOSS): it/they/she + arrange/organize/compose +
SOLUTION 3: (Hello) [naZ~am_1] tu/IV3FS+naZ~im/VERB_IMPERFECT
(GLOSS): it/they/she + arrange/organize/regulate +

INPUT STRING:
LOOK-UP WORD: jAmEp
SOLUTION 1: (two) [jAmiE_1] jAmiE/NOUN+ap/NSUFF_FEM_SG
(GLOSS): + comprehensive/extensive + [fem.sg.]


how can i change this code to help me:

Open "C:\second.txt" For Input As #1
        tmp = Split(Input(LOF(1), 1), vbCrLf)
    Close #1 
    
   For X = 0 To UBound(tmp)        
        If UCase(Left(tmp(X), 10)) = "  SOLUTION" Then            
            Words = Split(tmp(X), "(")
      
       'what i need then

[westconn1]

easy to do,
open first file and split, same way as second file
use instr to find position of "(" and again to find position of ")"
then use mid to join the part upto and including "(", & the replacement from the first file array & mid again the part from and including ")"
advance the index for the array from first file so that it will put the next string each time
lastly use join for the array of lines, open the second file again, this time for output then print the joined string to the file and close

[om-yousif]

sure
it should be easy to a programmer like you

but in my case as a mother of 3 kids
in addition to this that i didn't write any code since 2000

i think that it's not easy for me to write the code

OK i can understand what u wrote but i forgot most of the key word in VB and how to write the code
could you please help me with that

[westconn1]

try like this, but it isn't tested
if you want to write program you got to learn code again

Dim arrfirst() As String, arrsecond() As String, i As Long, j As Long
Dim pos As Long, pos1 As Long
f1 = FreeFile
Open "first.txt" For Input As f1  ' add path to file
    arrfirst = split(Input(LOF(f1), #f1), vbNewLine)
    Close f1
 
Open "second.txt" For Input As f1
    arrsecond = split(Input(LOF(f1), #f1), vbNewLine)
    Close f1
j = 0
For i = 0 To UBound(arrsecond)
    If Left(arrsecond(i), 10) = "  SOLUTION" Then   ' from your post though don't look quite right
        pos = InStr(arrsecond(i), "(") 'start position
        pos1 = InStr(arrsecond(i), ")")  ' end position
        arrsecond(i) = Mid(arrsecond(i), 1, pos) & arrfirst(j) & Mid(arrsecond(i), pos1, Len(arrsecond(i)) - pos1 + 1)
        j = j + 1
        
    End If
    
Next
Open "second.txt" For Output As f1   'overwrite updated data to file
    Print #f1, join(arrsecond, vbNewLine)
    Close f1

[om-yousif]

it point to this line and gives an error
"subscript out of range"

arrsecond(i) = Mid(arrsecond(i), 1, pos) & arrfirst(j) & Mid(arrsecond(i), pos1, Len(arrsecond(i)) - pos1 + 1)

what's the problem


by the way
thanks for your advice
i will try my best to be a good programmer as i was befor

[westconn1]

i or j has gone past it's valid value
i probably can't do, so it is most likly j, this will happen if more replacements are needed than in first file

[leinad31]

You need to check upper bound of both arrays.

Option Explicit
 
Private Sub Form_Load()
Dim arrfirst() As String
Dim arrsecond() As String
Dim f1 As Integer
Dim cnt As Long
 
   f1 = FreeFile:   Open "C:\first.txt" For Input As #f1  ' update file path
      arrfirst = Split(Input(LOF(f1), #f1), vbCrLf)
   Close f1
 
   f1 = FreeFile:   Open "C:\second.txt" For Input As #f1
      arrsecond = Split(Input(LOF(f1), #f1), vbCrLf & "SOLUTION ")
   Close f1
   
   cnt = 1
   Do
      arrsecond(cnt) = Left(arrsecond(cnt), InStr(1, arrsecond(cnt), "(")) _
         & arrfirst(cnt - 1) & Mid(arrsecond(cnt), InStr(1, arrsecond(cnt), ")"))
      cnt = cnt + 1
   Loop Until cnt - 1 > UBound(arrfirst) Or cnt > UBound(arrsecond)
   
   f1 = FreeFile:   Open "C:\result.txt" For Output As #f1
      Print #f1, Join(arrsecond, vbCrLf & "SOLUTION ")
   Close #f1
End Sub

[om-yousif]

i tried that westconn1
again
but it do a replacement with no relation to the first file
i mean it put some unknown words i don't know why?

[Merri]

Giving an example of the errorneus results might help the person who tries to help

[westconn1]

i have no idea how it can make a replacement that is not in the list, post your complete code, also the text files if possible so i can try it

[om-yousif]

i hope u can help me with this because the first file is written in arabic
newoutfile.txt is the first file
and outfile.txt is the second file that i need to change

i need to put the code as a function

[om-yousif]

i tried this code for another similar file but this code replaces each letter
with another one
can i change it to be helpful in my case

Dim pos1 As Long, pos2 As Long, i As Long
Dim file As String, line As String, word As String
    file = vbNullString
    i = 0
        Open "C:\buckwalter_morphan_1\data\outfile.txt" For Input As #1
            Do While Not EOF(1)
                Line Input #1, line
                    i = i + 1
                    pos1 = InStr(1, line, "(")
                    pos2 = InStr(1, line, ")")
                        If pos1 > 0 And pos2 > 0 Then
                            word = Mid(line, pos1 + 1, pos2 - pos1 - 1)
                            
                                word = Replace(word, "'", "Á")
                                word = Replace(word, "|", "Â")
                 
                                '...
                                'define all replacements up to letters(25)
                                
                            line = Left(line, pos1 - 1) & "(" & word & ")" & Right(line, Len(line) - pos2)
                        End If
                            If i = 1 Then
                                file = line
                            Else
                                file = file & vbCrLf & line
                            End If
            Loop
        Close #1
        
            Open "C:\buckwalter_morphan_1\data\outfile.txt" For Output As #1
                Print #1, file
            Close #1
                MsgBox "Done!"

[gavio]

Haha... that's my code from few mounths ago!

How would you like to change it?

[om-yousif]

Yes
Hi gavio that's your code

this code is replaceing each letter between the brackets with another letter
according to the replacements that i add

so this code is applying the same method to all brackets


what i need is to replace the first word between brackets found in the first file with the first word in the second file and so one.....

(the replacement should not applied in case of in the word between brackets was (GLOSS))

YOU CAN READ PRVIOUS THREADS


I'M SURE THAT YOU CAN DO IT

[westconn1]

i downloaded your textfiles and ran the code as i posted above, i just copied from the post, changed the file names, it gave no errors and appeared to work right
here is the output file

Edit: you were quite right, i could not understand the arabic at all, which is why i say appeared to work, you can check it out

[om-yousif]

i saw the file westconn1
i got the same output
and this is what i got between the bracets which is not understandable

ط§ظ„ط¬ظژظ…ظ’ط¹ظگظٹظ‘ظژط©

whats the problem ??????!!!!!

[westconn1]

some of the replacement text (the arabic) is unicode, i don't know too much about unicode, but read this post here http://www.vbforums.com/showthread.php?t=365738, about unicode in vb6, there will be many other posts on converting to unicode, vb automaically converts the unicode from the file to ANSI as soon as it reads the file, if you read the file as a byte array you then have the values to get the unicode character from the 2 bytes that make the unicode character, but i am unable to tell you how to put the unicode into your string and save it.

after typing all this i just made it work so try this code

Sub om()
 
Dim arrfirst() As Byte, arrsecond() As String, i As Long, j As Long
Dim pos As Long, pos1 As Long, strt As Long, arra() As Byte, arrb() As Byte
f1 = FreeFile
Open "C:\Documents and Settings\peter\My Documents\newoutfile.txt" For Input As f1  ' add path to file
    arrfirst = Input(LOF(f1), #f1)
    Close f1
 
For i = 0 To UBound(arrfirst)
    Debug.Print arrfirst(i)
Next
Open "C:\Documents and Settings\peter\My Documents\outfile.txt" For Input As f1
    arrsecond = split(Input(LOF(f1), #f1), vbNewLine)
    Close f1
Open "C:\Documents and Settings\peter\My Documents\testoutfile.txt" For Output As f1   'overwrite updated data to file
strt = 0
 
For i = 0 To UBound(arrsecond)
    If Left(arrsecond(i), 10) = "  SOLUTION" Then   ' from your post though don't look quite right
        pos = InStr(arrsecond(i), "(") 'start position
        pos1 = InStr(arrsecond(i), ")")  ' end position
rpl = getnext(arrfirst, strt)
strt = strt + (Len(rpl) * 2) + 2
For n = 0 To UBound(rpl)
Next
        arra = Mid(arrsecond(i), 1, pos)
        arrb = Mid(arrsecond(i), pos1, Len(arrsecond(i)) - pos1 + 1)
    Print #f1, arra; rpl; arrb
        j = j + 1
        
    End If
    Next
    Close f1
End Sub
Function getnext(arri() As Byte, strt As Long)
Dim i As Long, arrb() As Byte
ReDim arrb(100)
For i = strt To UBound(arri)
 
    If arri(i) = 13 Then
    Exit For
    Else
        arrb(i - strt) = arri(i)
    End If
Next
ReDim Preserve arrb(i - strt - 1)
getnext = arrb
End Function

i am not sayin the coding is perfect, but try it out and see if it is correct, i also attatch the result file

[om-yousif]

very good it's correct

but i need to overwrite in the outfile not in testoutfile
i mean without extracting the solutions lines and put them in other file
i need all information and the same arrangment of outfile
because most of my codes depends on outfile.txt arrangment

thanks

[westconn1]

i just change it to a separate output file, so i could run the code again without keep recopying the files after they had been overwritten
just change the filename for output back to the one you want, it makes no difference

as i said i am not sure that this is the proper way to code, so someone might put up some improvments

[om-yousif]

no i think that you did't understand i need to keep all information in the outfile ... if i just change the files names i will lose some data that i need in other functoins in outfile.txt

i attached a sample of output with all information i need which i didn't got in file outfile.txt

and the second one (outfile2.txt) is what i'm getting know

[westconn1]

in the previous, i think the first arabic word was incorrect, but that was what was making the it show the arabic words

here is code i think will do all you require, as far as i can tell it is correct

Sub om()
 
Dim arrfirst() As Byte, arrsecond() As String, i As Long
Dim pos As Long, pos1 As Long, strt As Long
Dim bom() As Byte
f1 = FreeFile
ReDim arrfirst(FileLen("C:\Documents and Settings\peter\My Documents\newoutfile.txt") - 1)
Open "C:\Documents and Settings\peter\My Documents\newoutfile.txt" For Input As f1  ' add path to file
    arrfirst = Input(LOF(f1), #f1)  ' file containing arabic replacements into byte array
    Close f1
    
 
Open "C:\Documents and Settings\peter\My Documents\outfile.txt" For Input As f1
    arrsecond = split(Input(LOF(f1), #f1), vbNewLine) ' string array of file needing replacements
    Close f1
Open "C:\Documents and Settings\peter\My Documents\testoutfile.txt" For Output As f1   'overwrite updated data to file
ReDim bom(5)
For i = 0 To 5 'read BOM from file
    bom(i) = arrfirst(i)
Next
Print #f1, bom;
strt = 6 ' start after BOM
 
For i = 0 To UBound(arrsecond)
    If Left(arrsecond(i), 10) = "  SOLUTION" Then   ' find line for replace
        pos = InStr(arrsecond(i), "(") 'start position
        pos1 = InStr(arrsecond(i), ")")  ' end position
rpl = getnext(arrfirst, strt) ' to get the first line from the byte array
strt = strt + (Len(rpl) * 2) + 4  ' next starting position in byte array
        
  ' print the line to file, with replacement
    Print #f1, Mid(arrsecond(i), 1, pos); rpl; Mid(arrsecond(i), pos1, Len(arrsecond(i)) - pos1 + 1) ' print the line to file, with replacement
        Else
        Print #f1, arrsecond(i)  '; rpl
    End If
    Next
    Close f1
End Sub
Function getnext(arri() As Byte, strt As Long)
Dim i As Long, arrb() As Byte
ReDim arrb(100)
For i = strt To UBound(arri)
 
    If arri(i) = 13 Then
    Exit For
    Else
        arrb(i - strt) = arri(i)
    End If
Next
ReDim Preserve arrb(i - strt - 1)
getnext = arrb
End Function

[westconn1]

here is a simpler code that does not use byte array, except to write BOM

Sub om1()
 
Dim arrfirst() As String, arrsecond() As String, i As Long
Dim pos As Long, pos1 As Long, j As Long
Dim bom() As Byte
f1 = FreeFile
Open "C:\Documents and Settings\peter\My Documents\newoutfile.txt" For Input As f1  ' add path to file
    arrfirst = split(Input(LOF(f1), #f1), vbNewLine) ' file containing arabic replacements into byte array
    Close f1
    
 
Open "C:\Documents and Settings\peter\My Documents\outfile.txt" For Input As f1
    arrsecond = split(Input(LOF(f1), #f1), vbNewLine) ' string array of file needing replacements
    Close f1
Open "C:\Documents and Settings\peter\My Documents\testoutfile.txt" For Output As f1   'overwrite updated data to file
ReDim bom(5)
bom(0) = &HEF
bom(2) = &HBB
bom(4) = &HBF
Print #f1, bom;
 
For i = 0 To UBound(arrsecond)
    If Left(arrsecond(i), 10) = "  SOLUTION" Then   ' find line for replace
        pos = InStr(arrsecond(i), "(") 'start position
        pos1 = InStr(arrsecond(i), ")")  ' end position
        
  ' print the line to file, with replacement
    Print #f1, Mid(arrsecond(i), 1, pos); arrfirst(j); Mid(arrsecond(i), pos1, Len(arrsecond(i)) - pos1 + 1) ' print the line to file, with replacement
    j = j + 1
        Else
        Print #f1, arrsecond(i)  '; rpl
    End If
    Next
    Close f1
End Sub