My Word macro doesn't find the second word - vba

Question

I want to create a VBA script in Microsoft Word to find inside a txt file if exist some line with ":" character. If this is true, I want to get this line, split it and insert this information in a table that is in main file. To this objetive, I want to go through all found lines to get this information.
For this, I have this code:
Dim arrNames
Dim cont As Integer
cont = 0
strPath = ActiveDocument.name
Documents.Open path & "Mails.txt"
strPath2 = ActiveDocument.name
With Selection.Find
.Text = ":"
Do While .Execute(Forward:=True, Format:=True) = True
Selection.Find.Execute FindText:=(":")
Selection.Expand wdLine
arrNames = Split(Selection.Text, ":")
Documents(strPath).Activate
If cont = 0 Then
Call gestOSINT("Pwd")
Selection.Find.Execute FindText:=("[Pwd]")
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Tabla con cuadrícula" Then
.Style = "Tabla con cuadrícula"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Set tblNew = Selection.Tables(1)
tblNew.Style = "Tabla de lista 1 clara - Énfasis 1"
Selection.TypeText Text:="Correo electrónico"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Tipo de filtrado"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Plataforma"
End If
Set rowNew = tblNew.Rows.Add
rowNew.Cells(1).Range.Text = arrNames(0)
rowNew.Cells(2).Range.Text = arrNames(1)
rowNew.Cells(3).Range.Text = arrNames(2)
cont = cont + 1
Documents(strPath2).Activate
Selection.Text = arrNames(0) & vbCrLf
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Collapse wdCollapseEnd
Loop
End With
Documents(strPath2).Activate
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
Documents(strPath).Activate
If cont = 0 Then
pwdMails = False
Else
pwdMails = True
End If
And Mails.txt file contain the following:
mail#mail.com
mail2#mail.com
mail3#mail.com:word1:word2
mail4#mail.com
mail5#mail.com:word3:word4
The first line which contain ":", line 3 in Mails.txt, was found but the second line, line 5 in Mails.txt, wasn't found.
Why occur this? How can I fix it?

Answer 1

Here is a version that reads the file via FileSystemObject and avoids using Selection. PLease note that I commented out lines that do not work for me (style names, custom functions).
Also: you are applying two styles to the table, first one then the other. Please pick one. ;-)
Const ForReading = 1
Dim arrNames
Dim cont As Integer
Dim fso, MyFile, FileName, TextLine, tblNew As Table, newRow As Row
Set fso = CreateObject("Scripting.FileSystemObject")
cont = 0
If cont = 0 Then
'Call gestOSINT("Pwd")
'Selection.Find.Execute FindText:=("[Pwd]")
Set tblNew = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=1, NumColumns:= _
3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed)
With tblNew
' If .Style <> "Tabla con cuadrícula" Then
' .Style = "Tabla con cuadrícula"
' End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
' .Style = "Tabla de lista 1 clara - Énfasis 1"
End With
With tblNew.Rows(1)
.Cells(1).Range.text = "Correo electrónico"
.Cells(2).Range.text = "Tipo de filtrado"
.Cells(3).Range.text = "Plataforma"
End With
End If
FileName = path & "Mails.txt"
Set MyFile = fso.OpenTextFile(FileName, ForReading)
Do While MyFile.AtEndOfStream <> True
TextLine = MyFile.ReadLine
If InStr(1, TextLine, ":") > 0 Then
arrNames = VBA.split(TextLine, ":")
Set rowNew = tblNew.Rows.Add
rowNew.Cells(1).Range.text = arrNames(0)
rowNew.Cells(2).Range.text = arrNames(1)
rowNew.Cells(3).Range.text = arrNames(2)
End If
Loop
MyFile.Close
If cont = 0 Then
pwdMails = False
Else
pwdMails = True
End If