Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 297
  • Last Modified:

Insert text at the of a text file line

Hi experts,

I have a text file with thousands of lines. Some lines are shorter than others. To accomplish what i want i need all lines to be the same lenght which is (601 characters). The code below reads each line and subtracts the difference from the goal of 601. The next step is to fill out with spaces (hence my character variable) the missing characters.
The program adds spaces to the text file but it adds at the bottom after the last line instead of adding it to the right side or end of each line.

Does anyone have any sugestions?

Thanks
Andre

Dim filename As String
Dim rowlenght As Long
Dim stringlenght As Integer
Dim i As Integer
Dim character As String

character = Chr$(13)

rowlenght = 10

filename = txtFilename.Text

Dim Line As String
Open filename For Append As #1
Open filename For Input As #1
Do While Not EOF(1)
  Line Input #1, Line
  stringlenght = rowlenght - Val(Len(Line))
  Close (1)
  Open filename For Append As #1
  For i = 0 To stringlenght
  'Line  #1, character
  Write #1, character
  Next
  'MsgBox ("Lenght :" & stringlenght & " Text: " & Line)
Loop
0
virgilar
Asked:
virgilar
2 Solutions
 
J_K_M_A_NCommented:
I would create a loop and use line input instead. Measure the length of the line and add the needed number of spaces to it. Then write that line out to a different file. It would be easier I think. That is going to be one monster file if you have thousands of lines and 601 chars per line. Good luck.

J_K_M_A_N
0
 
taycuong76Commented:
This program assume that you want to change the length of all line in a file to 10
You create a file on c:\ and named as "test.txt" with the content not equal, ex:
123456789
1234567890
1234
12345
1234122
1

Create a new VB project and add the code:
Private Sub Form_Load()
Dim filename As String
Dim i As Integer
Const rowlenght = 10

filename = "c:\test.txt"
filename2 = "c:\temp$$$.Txt"

Dim Line As String
Open filename For Input As #1
Open filename2 For Output As #2
Do While Not EOF(1)
Line Input #1, Linex
    If Len(Trim(Linex)) < 10 Then
    trang = 10 - Len(Linex)
    Linex = Linex & Space(trang)
'   MsgBox Len(Linex) & "-" & (10 - Len(Linex)) & "-" & Linex
    End If
Print #2, Linex
Loop
Close (1)
Close (2)
Kill filename
Name filename2 As filename
Msgbox "Done !"
End Sub

This will create a temp file, ajust the line thength (add space (" ") to the line which have length less than 10) then kill old file and named temp file back to original file.

Note: Make a copy of your file before test.
Hope this help, tested on VB 6 - XP sp2
0
 
taycuong76Commented:
Change the Const rowlenght = 10 to Const rowlenght = 610 to do with your data file (Make a copy of your file first.)

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
taycuong76Commented:
There is a situation: if your one of your lines longer than 10?????

In this case, you have to add some code like that:
  ....
  If Len(Trim(Linex)) > 10 Then
   'Only select 10 char from original line
    Linex = left(Linex,10)
  End If
 ......

But in fact, this is funny, because your data will be truncated to 10 and you'll lost the rest of your data !
0
 
BrianGEFF719Commented:
This should do it for you:


Dim strLine As String
Dim strBuffer As String
Dim strInputFile As String
Dim strTempFile As String

strInputFile = "c:\test.txt"
strTempFile = "c:\test.tmp"


Open strInputFile For Input As #1
    Open strTempFile For Output As #2
     While Not EOF(1)
      Line Input #1, strLine
      strBuffer = Space(601 - Len(strLine))
      Print #2, strLine & strBuffer
     Wend
    Close #2
Close #1

Kill strInputFile
FileCopy strTempFile, strInputFile
Kill strTempFile
0
 
taycuong76Commented:
BrianGEFF719, just the same mine. Nothing special.
0
 
BrianGEFF719Commented:
I like to think mine is a little more organized.
0
 
taycuong76Commented:
You 'd better find a new way and solution to help peoples.
0
 
Shiju SasidharanCommented:
or try this

Private Sub Command1_Click()
Dim oFso, oText
Dim sFile, sContent As String
    Set oFso = CreateObject("Scripting.FileSystemObject")
    sFile = "C:\Your_file.txt"
    If Not oFso.FileExists(sFile) Then
        MsgBox "File does not exist"
        Exit Sub
    End If
    Set oText = oFso.OpenTextFile(sFile)
    sContent = oText.ReadAll
    oText.Close
    'Filling spaces
    sContent = FillSpaces(sContent, 601)
    'Writing new data
    sFile = "C:\Your_New_file.txt"
    Set oText = oFso.OpenTextFile(sFile, ForWriting, True)
    oText.Write sContent
    oText.Close
    MsgBox "Done"
End Sub

Private Function FillSpaces(ByVal Content As String, ByVal Length As Integer) As String
Dim oReg
Dim oMat
Dim oMCol
    Set oReg = CreateObject("VBScript.RegExp")
    With oReg
        .IgnoreCase = True
        .Global = True
        .Pattern = "(.{1," & Length & "})\r\n"
    End With
    Content = Content & vbCrLf 'Adding new line to get last line
    Set oMCol = oReg.Execute(Content)
    For Each oMat In oMCol
        Content = Replace(Content, oMat.Value, oReg.Replace(oMat.Value, "$1" & Space(Length - Len(oMat.Value) + 2) & vbCrLf))
    Next
    FillSpaces = Left(Content, Len(Content) - 2) 'Removing last new line
End Function
0
 
taycuong76Commented:
Good training job using FileSystemObject.
0
 
virgilarAuthor Commented:
taycuong76 and BrianGEFF719 and everybody else,

Thaks a lot for your inputs, i was able to accomplish exactly what i wanted.

I will split the point between taycuong76 and BrianGEFF719  since their answers helped me directly with my needs.

Thanks guys,

Andre
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now