none
Performing text search using conditions RRS feed

  • Question

  • Hello,

    I would like to perform the following steps:

    1. Providing an if...then structure based on the following text searches: *[n], *[adj], *[adv], *[v]  words before each speech type.

    2. Perform a find operation based on the following text

    3. Set conditions for each speech

    4. Create text files using file handling techniques

    So far...I have this following source code

    Sub AllEntriesToDifferentFiles()
    Dim strX, strZ As String
    Dim n As Integer
    n = FreeFile()

    With Word.Selection
        .Find.Forward = True
        .Find.Execute ("*[n]") 'find all nouns or text before the identifying noun
        If .Find.Found = True Then
            .Select
            .Copy
    Open "C:\Users\John\Documents\Nouns.txt" For Output As #n
    Write #n, strX
    Close #n
        End If

    End With

    End Sub

    It ran fine right now, but nothing happened as I run it.

    Can anyone help me on how to perform this task?

    JohnDBCTX

    Tuesday, June 14, 2016 12:47 AM

Answers

  • You really should have said what you wanted at the outset. The code I posted works perfectly fine for what you specified in your first post - it produces four separate files - one each for Nouns, Adjectives, Adverbs, & Verbs. You made no mention of anything being sorted or that you wanted anything 'categorized', whatever that means. For sorted outputs, you could use:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim StrTxt() As String, i As Long, j As Long, n As Long
    Const StrFnd As String = "n,adj,adv,v"
    Const StrOut As String = "Nouns,Adjectives,Adverbs,Verbs"
    For i = 0 To UBound(Split(StrFnd, ","))
      ReDim StrTxt(0): j = 0: n = FreeFile()
      With ActiveDocument.Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
           .Forward = True
          .Wrap = wdFindStop
          .MatchWildcards = True
          .Text = "\*\[" & Split(StrFnd, ",")(i) & "\]?[! ]@>"
          .Execute
        End With
        Do While .Find.Found
          ReDim Preserve StrTxt(j)
          StrTxt(j) = Trim(Split(.Text, "]")(1))
          j = j + 1
           .Collapse wdCollapseEnd
          .Find.Execute
        Loop
      End With
      WordBasic.SortArray StrTxt()
      Open "C:\Users\" & Environ("Username") & "\Documents\" & Split(StrOut, ",")(i) & ".txt" For Output As #n
      Print #n, Join(StrTxt(), vbCrLf)
      Close #n
    Next
    Application.ScreenUpdating = True
    End Sub

    If you care to explain what you mean by 'categorize', something might be done on that front also.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by JohnDBCTX Wednesday, June 15, 2016 12:23 AM
    Tuesday, June 14, 2016 11:08 PM
  • As coded, your macro will only find a single instance of "*[n]" and, having done that, opens the Nouns.txt file which it populates with a empty strX variable. Selecting & copying the found text does not add it to the strX variable. Try:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim StrTxt As String, i As Long, n As Long
    Const StrFnd As String = "n,adj,adv,v"
    Const StrOut As String = "Nouns,Adjectives,Adverbs,Verbs"
    For i = 0 To UBound(Split(StrFnd, ","))
      StrTxt = "": n = FreeFile()
      With ActiveDocument.Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Forward = True
          .Wrap = wdFindStop
          .MatchWildcards = True
          .Text = "\*\[" & Split(StrFnd, ",")(i) & "\]?[! ]@>"
          .Execute
        End With
        Do While .Find.Found
          StrTxt = StrTxt & Trim(Split(.Text, "]")(1)) & vbCrLf
          .Collapse wdCollapseEnd
          .Find.Execute
        Loop
      End With
      Open "C:\Users\" & Environ("Username") & "\Documents\" & Split(StrOut, ",")(i) & ".txt" For Output As #n
      Print #n, StrTxt
      Close #n
    Next
    Application.ScreenUpdating = True
    End Sub

    The above code assumes you have *[n], *[adj], *[adv], or *[v] before each of the words to be extracted, with no more than a single space between the *[n], *[adj], *[adv] or *[v] and the word.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by JohnDBCTX Wednesday, June 15, 2016 12:23 AM
    Tuesday, June 14, 2016 3:57 AM
  • How about if I try this source code?

    Sub AllEntriesToDifferentFiles()
    Dim strX As String
    Dim x As Long

    Open "C:\Users\John\Documents\Roget\Pages 11 to 91\Document Cloud\Pages 42 to 109.txt" For Input As #1
    For x = 0 To 10
          Line Input #1, strX
          strX = strX + contents
    Next x
    Close #1

    Open "C:\Users\John\Documents\Text Number One.txt" For Output As #2
    Write #2, strX
    Close #2

    End Sub

    And here is the output in Text Number One.txt:

    "stomach, sweet tooth*, taste, thirst, urge, "  //Print out in Line 10

    This means that this code that I have written and have run perfectly.  Now to get back to the subject how would I need to improve the previous source code?

    Could I use a running calculation parameter within the source code as mentioned above,

    from lines 1 and up?



    I have no idea what you're trying to do with your AllEntriesToDifferentFiles macro, which wasn't posted before I started my previous reply. I suggest you start a new thread for that topic and explain exactly what you're trying to do and what relation, if any, it has to the code discussed in this thread. Your description, as quoted, is quite opaque.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by JohnDBCTX Wednesday, June 15, 2016 3:04 AM
    Wednesday, June 15, 2016 12:45 AM

All replies

  • As coded, your macro will only find a single instance of "*[n]" and, having done that, opens the Nouns.txt file which it populates with a empty strX variable. Selecting & copying the found text does not add it to the strX variable. Try:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim StrTxt As String, i As Long, n As Long
    Const StrFnd As String = "n,adj,adv,v"
    Const StrOut As String = "Nouns,Adjectives,Adverbs,Verbs"
    For i = 0 To UBound(Split(StrFnd, ","))
      StrTxt = "": n = FreeFile()
      With ActiveDocument.Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Forward = True
          .Wrap = wdFindStop
          .MatchWildcards = True
          .Text = "\*\[" & Split(StrFnd, ",")(i) & "\]?[! ]@>"
          .Execute
        End With
        Do While .Find.Found
          StrTxt = StrTxt & Trim(Split(.Text, "]")(1)) & vbCrLf
          .Collapse wdCollapseEnd
          .Find.Execute
        Loop
      End With
      Open "C:\Users\" & Environ("Username") & "\Documents\" & Split(StrOut, ",")(i) & ".txt" For Output As #n
      Print #n, StrTxt
      Close #n
    Next
    Application.ScreenUpdating = True
    End Sub

    The above code assumes you have *[n], *[adj], *[adv], or *[v] before each of the words to be extracted, with no more than a single space between the *[n], *[adj], *[adv] or *[v] and the word.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by JohnDBCTX Wednesday, June 15, 2016 12:23 AM
    Tuesday, June 14, 2016 3:57 AM
  • I have seen what you did regarding the source code.

    It did create the Nouns, Verbs, Adjectives, and Adverbs in Notepad simultaneously - all of them in text file format.

    Now the only obstacle I need to overcome is to output the entries and categorize them in alphabetical order by speech type.

    So far I have altered some of the source code:

    Sub DemoExtract()
     Application.ScreenUpdating = False
     Dim StrTxt As String, i As Long, n As Long
     Const StrFnd As String = "n,adj,adv,v"
     Const StrOut As String = "Nouns,Adjectives,Adverbs,Verbs"
     For i = 0 To UBound(Split(StrFnd, ","))
       StrTxt = "": n = FreeFile()
       With ActiveDocument.Range
         With .Find
           .ClearFormatting
           .Replacement.ClearFormatting
           .Forward = True
           .Wrap = wdFindContinue
           .MatchWildcards = True
           .Text = "\*\" & Split(StrFnd, ",")(i)
           .Execute
         End With
        If StrFnd = "n" Then
         Do While .Find.Found = True
           StrTxt = StrTxt & Trim(Split(.Text, "]")(1)) & vbCrLf
           .Find.Execute
         Loop
         End If
         If StrFnd = "v" Then
         Do While .Find.Found = True
           StrTxt = StrTxt & Trim(Split(.Text, "]")(1)) & vbCrLf
           .Find.Execute
         Loop
         End If
         If StrFnd = "adj" Then
         Do While .Find.Found = True
           StrTxt = StrTxt & Trim(Split(.Text, "]")(1)) & vbCrLf
           .Find.Execute
         Loop
         End If
         If StrFnd = "adv" Then
         Do While .Find.Found = True
           StrTxt = StrTxt & Trim(Split(.Text, "]")(1)) & vbCrLf
           .Find.Execute
         Loop
         End If
        
       End With
       Open "C:\Users\" & Environ("Username") & "\Documents\" & Split(StrOut, ",")(i) & ".txt" For Output As #n
       Print #n, StrTxt
       Close #n
     Next
     Application.ScreenUpdating = True
     End Sub

    I ran it and the result:  All four files are still created but no categorized output.

    How can I improve this source code, so that it can work property?

    JohnDBCTX

    Tuesday, June 14, 2016 8:26 PM
  • I have updated the source code just to make it logically sound correct.

    Sub DemoExtract()
     Application.ScreenUpdating = False
     Dim StrTxt As String, i As Long, n As Long
     Const StrFnd As String = "n,adj,adv,v"
     Const StrOut As String = "Nouns,Adjectives,Adverbs,Verbs"
     For i = 0 To UBound(Split(StrFnd, ","))
       StrTxt = "": n = FreeFile()
       With ActiveDocument.Range
         With .Find
           .ClearFormatting
           .Replacement.ClearFormatting
           .Forward = True
           .Wrap = wdFindContinue
           .MatchWildcards = True
           .Text = "\*\" & Split(StrFnd, ",")(i)
           .Execute
         End With
        If StrFnd = "n" Then
         Do While .Find.Found = True
           StrTxt = StrTxt & Trim(Split(.Text, "]")(1)) & vbCrLf
           .Find.Execute
            Open "C:\Users\" & Environ("Username") & "\Documents\" & Split(StrOut, ",")(i) & ".txt" For Output As #n
            Print #n, StrTxt
            Close #n
         Loop
         End If
         If StrFnd = "v" Then
         Do While .Find.Found = True
           StrTxt = StrTxt & Trim(Split(.Text, "]")(1)) & vbCrLf
           .Find.Execute
            Open "C:\Users\" & Environ("Username") & "\Documents\" & Split(StrOut, ",")(i) & ".txt" For Output As #n
            Print #n, StrTxt
            Close #n
         Loop
         End If
         If StrFnd = "adj" Then
         Do While .Find.Found = True
           StrTxt = StrTxt & Trim(Split(.Text, "]")(1)) & vbCrLf
           .Find.Execute
            Open "C:\Users\" & Environ("Username") & "\Documents\" & Split(StrOut, ",")(i) & ".txt" For Output As #n
            Print #n, StrTxt
            Close #n
         Loop
         End If
         If StrFnd = "adv" Then
         Do While .Find.Found = True
           StrTxt = StrTxt & Trim(Split(.Text, "]")(1)) & vbCrLf
           .Find.Execute
            Open "C:\Users\" & Environ("Username") & "\Documents\" & Split(StrOut, ",")(i) & ".txt" For Output As #n
            Print #n, StrTxt
            Close #n
         Loop
         End If
        
       End With
       Open "C:\Users\" & Environ("Username") & "\Documents\" & Split(StrOut, ",")(i) & ".txt" For Output As #n
       Print #n, StrTxt
       Close #n
     Next
     Application.ScreenUpdating = True
     End Sub

    Still, same results, but no output to any of the files.

    What am I doing wrong, and how could I correct this problem?

    Would it be better if anyone provide me some links to input/output file handling as well?

    JohnDBCTX


    • Edited by JohnDBCTX Tuesday, June 14, 2016 9:26 PM Clarification
    Tuesday, June 14, 2016 9:05 PM
  • How about if I try this source code?

    Sub AllEntriesToDifferentFiles()
    Dim strX As String
    Dim x As Long

    Open "C:\Users\John\Documents\Roget\Pages 11 to 91\Document Cloud\Pages 42 to 109.txt" For Input As #1
    For x = 0 To 10
          Line Input #1, strX
          strX = strX + contents
    Next x
    Close #1

    Open "C:\Users\John\Documents\Text Number One.txt" For Output As #2
    Write #2, strX
    Close #2

    End Sub

    And here is the output in Text Number One.txt:

    "stomach, sweet tooth*, taste, thirst, urge, "  //Print out in Line 10

    This means that this code that I have written and have run perfectly.  Now to get back to the subject how would I need to improve the previous source code?

    Could I use a running calculation parameter within the source code as mentioned above,

    from lines 1 and up? 

    JohnDBCTX


    • Edited by JohnDBCTX Tuesday, June 14, 2016 11:02 PM Further clarification
    Tuesday, June 14, 2016 10:58 PM
  • You really should have said what you wanted at the outset. The code I posted works perfectly fine for what you specified in your first post - it produces four separate files - one each for Nouns, Adjectives, Adverbs, & Verbs. You made no mention of anything being sorted or that you wanted anything 'categorized', whatever that means. For sorted outputs, you could use:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim StrTxt() As String, i As Long, j As Long, n As Long
    Const StrFnd As String = "n,adj,adv,v"
    Const StrOut As String = "Nouns,Adjectives,Adverbs,Verbs"
    For i = 0 To UBound(Split(StrFnd, ","))
      ReDim StrTxt(0): j = 0: n = FreeFile()
      With ActiveDocument.Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
           .Forward = True
          .Wrap = wdFindStop
          .MatchWildcards = True
          .Text = "\*\[" & Split(StrFnd, ",")(i) & "\]?[! ]@>"
          .Execute
        End With
        Do While .Find.Found
          ReDim Preserve StrTxt(j)
          StrTxt(j) = Trim(Split(.Text, "]")(1))
          j = j + 1
           .Collapse wdCollapseEnd
          .Find.Execute
        Loop
      End With
      WordBasic.SortArray StrTxt()
      Open "C:\Users\" & Environ("Username") & "\Documents\" & Split(StrOut, ",")(i) & ".txt" For Output As #n
      Print #n, Join(StrTxt(), vbCrLf)
      Close #n
    Next
    Application.ScreenUpdating = True
    End Sub

    If you care to explain what you mean by 'categorize', something might be done on that front also.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by JohnDBCTX Wednesday, June 15, 2016 12:23 AM
    Tuesday, June 14, 2016 11:08 PM
  • This has been helpful only in regards to opening multiple text files simultaneously.  I will not waste any more time on that question.

    In addition; my routine, "AllEntriesToDifferentFiles", has run successfully as well.

    I do like to pardon myself for going off the subject at first, whereas this may be a stepping stone to what I want to perform my ultimate task.

    Using the AllEntriesToDifferentFiles as a code source reference to output, and your Demo procedure as another resource.  What I should do is to combine the two source codes and to call one of them.

    I shall keep your source code in mind for future purposes.

    JohnDBCTX

    Wednesday, June 15, 2016 12:33 AM
  • How about if I try this source code?

    Sub AllEntriesToDifferentFiles()
    Dim strX As String
    Dim x As Long

    Open "C:\Users\John\Documents\Roget\Pages 11 to 91\Document Cloud\Pages 42 to 109.txt" For Input As #1
    For x = 0 To 10
          Line Input #1, strX
          strX = strX + contents
    Next x
    Close #1

    Open "C:\Users\John\Documents\Text Number One.txt" For Output As #2
    Write #2, strX
    Close #2

    End Sub

    And here is the output in Text Number One.txt:

    "stomach, sweet tooth*, taste, thirst, urge, "  //Print out in Line 10

    This means that this code that I have written and have run perfectly.  Now to get back to the subject how would I need to improve the previous source code?

    Could I use a running calculation parameter within the source code as mentioned above,

    from lines 1 and up?



    I have no idea what you're trying to do with your AllEntriesToDifferentFiles macro, which wasn't posted before I started my previous reply. I suggest you start a new thread for that topic and explain exactly what you're trying to do and what relation, if any, it has to the code discussed in this thread. Your description, as quoted, is quite opaque.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by JohnDBCTX Wednesday, June 15, 2016 3:04 AM
    Wednesday, June 15, 2016 12:45 AM