Precise informations in text file to excel columns using VBA - vba

Question

[enter link description here][1]I'm trying to search specific words in this text file in order to output it's line content in excel columns. The text file contains multiple sections. I'm able to output the first section of my text file but for some reasons I can't define a loop so I could retrieve every section of the file.
My code so far :
Sub test()
Dim myFile As String, text As String, textline As String, DDC As Integer, DDR As Integer, DDP As Integer, ADC As Integer, i As Integer, SE As Integer, SP As Integer, SG As Integer, j As Integer, v As Integer
myFile = "C:\Users\Seb\Desktop\text2.txt"
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
i = 1
DDC = InStr(text, "Date de calcul")
DDR = InStr(text, "Date de retraite")
ADC = InStr(text, "Âge à la date du calcul")
SE = InStr(text, "Service d'emploi")
SP = InStr(text, "Service de participation")
SG = InStr(text, "Salaire gagné")
Cells(i + 1, 1).Value = Mid(text, DDC, 14)
Cells(i + 1, 2).Value = Mid(text, DDC + 36, 10)
Cells(i + 2, 1).Value = Mid(text, DDR, 16)
Cells(i + 2, 2).Value = Mid(text, DDR + 36, 10)
Cells(i + 3, 1).Value = Mid(text, ADC, 23)
Cells(i + 3, 2).Value = Mid(text, ADC + 36, 6)
Cells(i + 4, 1).Value = Mid(text, SE, 16)
Cells(i + 4, 2).Value = Mid(text, SE + 36, 6)
Cells(i + 5, 1).Value = Mid(text, SP, 24)
Cells(i + 5, 2).Value = Mid(text, SP + 36, 6)
For v = 0 To 10
j = v * 228
Cells(v + 7, 1).Value = Mid(text, SG + j, 24) + Mid(text, SG + 64 + j, 10) + "/ " + Mid(text, SG + 77 + j, 10)
Cells(v + 7, 2).Value = Mid(text, SG + 103 + j, 10)
Next v
End Sub
An exemple of my text file is available here: http://txt.do/5j2dq
As I mentioned before, I'm only able to output section 1 in excel. What my code should be in order to retrieve every sections of my text file?

Answer 1

After you have covered each section, simply remove the covered part from your text string, so that in the next iteration e.g. InStr(text, "Date 1") will find the Date 1 line of the next section.
Do While True
DDC = InStr(text, "Date 1")
If DDC = 0 Then
' no more sections - exit loop
Exit Do
End If
DDR = InStr(text, "Date 2")
ADC = InStr(text, "Age")
' ......
Next v
' remove the section that was just handled
text = Mid(text, SG + 30)
Loop

Answer 2

If you bring the TXT file in as Data ► External Data ► From Text, you can set period as an Other delimiter (with Treat consecutive delimiters as one being True).
Sub Import_Text()
Dim c As Long, myFile As String
myFile = "C:\Users\Seb\Desktop\text.txt"
With Worksheets("Sheet9") '<~~set this worksheet reference properly!
With .QueryTables.Add(Connection:="TEXT;" & myFile, _
Destination:=Range("$A$1"))
.Name = "TXT"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "."
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'these will cleanup (trim) the results
For c = 1 To 2
With .Columns(c)
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
End With
Next c
End With
End Sub
There are two final Range.TextToColumns method with the xlFixedWidth option that simply trim off any rogue leading/railing spaces from the results.