My wordマクロが2番目の単語を見つけられない

Question

"："文字を含む行がある場合、txtファイル内でMicrosoft WordでVBAスクリプトを作成したいと考えています。これが本当であるならば、私は、この行を取得し、それを分割し、メインファイルにあるテーブルでこの情報を挿入します。このobjetiveに、私はすべてのがこの情報を取得するためにラインを見つけて行きたいです。このため

、私はこのコードを持っている：

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 

そしてMails.txtファイルには、次が含まれています。

mail@mail.com 
mail2@mail.com 
mail3@mail.com:word1:word2 
mail4@mail.com 
mail5@mail.com:word3:word4 

含まれている最初の行を "："、Mails.txtで3行目をが見つかりましたが、2行目のMails.txtの5行目が見つかりませんでした。

これをなぜ起こりますか？どうすれば修正できますか？ここで

Answer 1

は、FileSystemObjectオブジェクトを経由してファイルを読み込み、Selectionを使用して回避したバージョンです。私は私のために働かない行（スタイル名、カスタム関数）をコメントアウトしたことに注意してください。 はまた：あなたは、テーブルに、他の最初のものを2つのスタイルを適用しています。選択してください。 ;-)

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