My Word macro doesn't find the second word

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?

When you use `Find` with `Selection`, always add `Selection.Collapse wdCollapseEnd` before you execute the next find, else Word will search in the selection only which now consists of your one line... Also: since this is a text file, consider using FileSystemObject: https://stackoverflow.com/questions/1719342/how-to-read-lines-from-a-text-file-one-by-one-with-power-point-vba-code — LocEngineer, Nov 21 '17 at 11:49

LocEngineer · Accepted Answer · 2017-11-21T15:41:12.160

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

This error appear: `Invalid procedure call or argument (Error 5)` — Iratzar Carrasson Bores, Nov 21 '17 at 15:11
@IratzarCarrassonBores Where? It ran for me. Please be more precise with errors. What line? — LocEngineer, Nov 21 '17 at 15:16
In this part of the code: `Set MyFile = fso.OpenTextFile(FileName, ForReading)` — Iratzar Carrasson Bores, Nov 21 '17 at 15:19
Set a break point there and debug.print FileName. I assume `path & "Mails.txt"` does not produce the correct full path to your Mails.txt — LocEngineer, Nov 21 '17 at 15:29

My Word macro doesn't find the second word

1 Answers1