Interate through Word text: Find, Move, Next 1

[waubain]

I am trying to iterate though Section(3) of a Word document, Find a key word then find the end of the block, copy the text and paste it to a bookmark in another section. I am trouble iterating through the document. Text gets pasted into Section(3) and has this structure. It has a carriage return(^p) at the end of each line.

[tt]
|INP| BISACODYL SUPP,RTL
10MG IN RECTUM EVERY DAY AS NEEDED FOR CONSTIPATION

|REMOTE| CHLORHEXIDINE GLUCONATE RINSE,ORAL
15 ML BY MOUTH FOUR TIMES A DAY swisha nd spit
BCMA ORDER LAST ACTION: 12/15/13 20:13 GIVEN

|OPT| CHOLECALCIFEROL (VIT D3) 2,000UNIT TAB (Status = ACTIVE)
TAKE ONE TABLET BY MOUTH EVERY DAY
Last Released: 1/16/13 Days Supply: 90
Rx Expiration Date: 1/16/14 Refills Remaining: 3

|NEW| CHOLECALCIFEROL (VIT D3) TAB
2000UNIT BY MOUTH EVERY DAY
BCMA ORDER LAST ACTION: 12/15/13 08:44 GIVEN
[/tt]

I found this example Link .
I tried to incorporate it into my code, but it does not seem go through each paragraph and also no longer stays contained into Section(3). There are about 10-12 different |*| prefixs. I know I will have problems with the bookmarks also (using a Greg Maxey example), but that is a different problem.

The Selection.Find.ClearFormatting and after does work correctly.

Option Explicit
Sub FindMoveBlockText()

    Dim strContent As String
    Dim strPrefix As String
    Dim doc As Document
    Dim para As Paragraph
    Dim paraNext As Paragraph
    Dim i As Integer
    
    ActiveDocument.Sections(3).Range.Select
    Set para = Selection.Paragraphs.First
    Do While Not para Is Nothing
    Set paraNext = para.Next
    Selection.Find.ClearFormatting
    With Selection.Find
        .ClearFormatting
        .Text = "|*|"
        .Replacement.Text = ""
        .Forward = True
        .Format = False
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute
    Selection.Extend
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^13^13"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute
    strContent = Selection.Text
    i = 0
    i = InStr(2, strContent, "|")
    strPrefix = Trim(Mid(strContent, 1, i + 1))
    
    If Len(strContent) = 0 Then
        MsgBox "No Text Found"
        Exit Sub
        Else
            Select Case strPrefix
                Case "|OPT|"
                    MsgBox "OPT"
                    'Call WriteToBookmarkRange(ActiveDocument, "bmVAMed", strContent)
                Case "|REMOTE|"
                    MsgBox "REMOTE"
                    'Call WriteToBookmarkRange(ActiveDocument, "bmRemoteMed", strContent)
                Case "|NONVA|"
                    MsgBox "NONVA"
                    'Call WriteToBookmarkRange(ActiveDocument, "bmNonVAMed", strContent)
                Case "|NEW|"
                    MsgBox "NEW"
                    'Call WriteToBookmarkRange(ActiveDocument, "bmVAMed", strContent)
                    'Call WriteToBookmarkRange(ActiveDocument, "bmNewMed", strContent)
                Case Else
                    MsgBox "Unknown Prefix" & vbCrLf & _
                           "Call for assistance"
            End Select
    End If
    Set para = paraNext
    Loop
End Sub

I am open to any suggestions on how to iterate through the text. This was the only example I found. I am also open to other ways to

Thank you.

You don't know what you don't know...

 

[SkipVought]

hi,

I'd try something like this, looping thru each paragraph in the section

'
    Dim par As Paragraph, a, strContent As String
    
    ActiveDocument.Sections(1).Range.Select
    
    For Each par In Selection.Paragraphs
        a = Split(par.Range.Text, " ")
        Select Case a(0)
            Case "|INP|"
                strContent = Right(par.Range.Text, Len(par.Range.Text) - Len(a(0)) - 1) & vbLf
            Case "|REMOTE|"
            
            Case Else
                strContent = strContent & Right(par.Range.Text, Len(par.Range.Text) - Len(a(0)) - 1) & vbLf
        End Select
    Next

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[SkipVought]

oops, I changed your section(3) to 1 for testing.

Also change the accumulation of strContent like this...

'
    Dim par As Paragraph, a, strContent As String
    
    ActiveDocument.Sections(1).Range.Select
[b]
'this part builds the text to put whereever.[/b]
    For Each par In Selection.Paragraphs
        a = Split(par.Range.Text, " ")
        Select Case a(0)
            Case "|INP|","|REMOTE|","|OPT
                strContent = Right(par.Range.Text, Len(par.Range.Text) - Len(a(0)) - 1) & vbLf
            Case Else
                strContent = strContent & Right(par.Range.Text, Len(par.Range.Text) - Len(a(0)) - 1) & vbLf
        End Select

[b]
' now you put your text string wherever you need to using your other Select Case
    Next

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[waubain]

Skip,
Thanks, I will give it a try. Before I do, it appears that this is only capturing the first line? I probably was not clear but I need to capture the entire block of text from the |string| until the next "^p^p" , which can be a variable number of lines.

[tt]
|OPT| CHOLECALCIFEROL (VIT D3) 2,000UNIT TAB (Status = ACTIVE)
TAKE ONE TABLET BY MOUTH EVERY DAY
Last Released: 1/16/13 Days Supply: 90
Rx Expiration Date: 1/16/14 Refills Remaining: 3
[/tt]

Thank you for the quick response.



You don't know what you don't know...

 

[SkipVought]

This is what is in strContent
[tt]
BISACODYL SUPP,RTL
IN RECTUM EVERY DAY AS NEEDED FOR CONSTIPATION
[/tt]

Here's the next
[tt]
CHLORHEXIDINE GLUCONATE RINSE,ORAL
ML BY MOUTH FOUR TIMES A DAY swisha nd spit
ORDER LAST ACTION: 12/15/13 20:13 GIVEN
[/tt]

and the next
[tt]
CHOLECALCIFEROL (VIT D3) 2,000UNIT TAB (Status = ACTIVE)
ONE TABLET BY MOUTH EVERY DAY
Released: 1/16/13 Days Supply: 90
Expiration Date: 1/16/14 Refills Remaining: 3
[/tt]

and the last
[tt]
CHOLECALCIFEROL (VIT D3) TAB
BY MOUTH EVERY DAY
ORDER LAST ACTION: 12/15/13 08:44 GIVEN
[/tt]


Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[waubain]

Skip,
Sorry for not trying first. This is what I am needing. My experience with Word VBA has spanned a full 4 days now, but my lack of wisdom has spanned 60+ years.

Bob

You don't know what you don't know...

 

[SkipVought]

I made some adjustments...

    Dim par As Paragraph, a, strContent As String
    
    ActiveDocument.Sections(1).Range.Select
    
    For Each par In Selection.Paragraphs
        a = Split(par.Range.Text, " ")
        Select Case a(0)
            Case "|INP|", "|REMOTE|", "|NEW|"
                strContent = Right(par.Range.Text, Len(par.Range.Text) - Len(a(0)) - 1) & vbLf
            Case vbCr
                Debug.Print strContent
                
            '[b]here's where the strContent is placed whereever...[/b]
                Select Case a(0)
                    Case "|INP|"
                        'Call WriteToBookmarkRange(ActiveDocument, "bmVAMed", strContent)
                    Case "|REMOTE|"
                        'Call WriteToBookmarkRange(ActiveDocument, "bmRemoteMed", strContent)
                End Select
                
             '[b]then clear the variable[/b]
                strContent = ""
            Case Else
                strContent = strContent & Right(par.Range.Text, Len(par.Range.Text) - Len(a(0)) - 1) & vbLf
        End Select
        
    Next

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[waubain]

Skip,
Thanks again.

You don't know what you don't know...

 

[waubain]

Skip,

I got a chance to study and implement your code this morning. I am having 2 problems that I cannot seem to resolve.

1) When the loop gets to the end of Section(3) I get a runtime error 5. The documentation on this error is sparse (unclear to me). In the above data, I see all 4 meds in the immediate window and the next loop I get the error and when I click debug it highlights the Case Else statement. It seems like when I hit the section break it prompts the error. The first statement of ActiveDocument.Sections(3).Range.Select does highlight the section break. It would seem to me that selecting Section(3) looping for each paragraph would not include the section break, but I have been mystified before in vba.

strContent = strContent & Right(par.Range.Text, Len(par.Range.Text) - Len(a(0)) - 1) & vbLf

2) a(0) is not recognized or carried forward(might not be the correct words) in the nested Select Case a(0). The Msgbox a(0) is blank.

Case vbCr
   Debug.Print strContent
   MsgBox a(0)
'here's where the strContent is placed whereever...
   Select Case a(0)
     Case "|OPT|"
        MsgBox "Copy to OPT"
        'Call WriteToBookmarkRange(ActiveDocument, "bmVAMed", strContent)
     Case "|INP|"
        MsgBox "Do Nothing"
     Case "|REMOTE|"
        'Call WriteToBookmarkRange(ActiveDocument, "bmRemoteMed", strContent)
End Select

I tried to attach my Word template to see the structure.

Thank you.

You don't know what you don't know...

 

[SkipVought]

okay. Each paragraph gets parsed on a SPACE selimiter, so that a(0) is the FIRST element, and perhaps the ONLY element in the string, which I would expect for the section break. Put a Debug.Print Asc(a(0)) to observe the value(s) in THAT string and include that value(s) in the Select Case: Case vbLf.

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[SkipVought]

sorry I should have posted an example...

    Dim s, j as integer
    'here's an example of 2 characters in the string
    s = vbLf & vbCr

    For j = 1 To Len(s)
        Debug.Print Asc(Mid(s, j, 1))
    Next
]/code]

Skip,
[sub]
[glasses]Just traded in my [b]OLD subtlety[/b]...
for a [b]NUance![/b][tongue][/sub]

 

[PHV]

In the snippet you posted as 2) you know for sure that a(0)=vbCr, so I don't understand why testing it again...
You should store the value of a(0) when you get a match and test against this stored value when you want to write the bookmark.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[waubain]

Thank you both. It is now working.

Skip: When trying to debug it this morning the character (female symbol) appeared in the Msgbox for strContent at the Section break. I then tried to add the Case "^b", but moved on when it did not work .I should have known from my screen scraping experiences that it was Chr(12) or vbFormFeed. I tried that now and that worked.

PHV: I think I understand what you are stating, but what I did worked.

Sub FindMoveBlockText()
Dim par As Paragraph, a, strContent As String
Dim strPrefix As String
    
    ActiveDocument.Sections(3).Range.Select
    
    For Each par In Selection.Paragraphs
        a = Split(par.Range.Text, " ")
        
        Select Case a(0)
            Case "|OPT|", "|REMOTE|", "|NONVA|", "|DISC|", "|RESUME|", "|BULK|", "|INP|"
                strContent = Right(par.Range.Text, Len(par.Range.Text) - Len(a(0)) - 1) & vbLf
                strPrefix = a(0)
            
            Case vbCr
                Debug.Print strContent
                
            'here's where the strContent is placed
                Select Case strPrefix
                    Case "|OPT|"
                        MsgBox "Copy to OPT"
                        'Call WriteToBookmarkRange(ActiveDocument, "bmVAMed", strContent)
                    Case "|INP|"
                        MsgBox "Do Nothing"
                    Case "|REMOTE|"
                        'Call WriteToBookmarkRange(ActiveDocument, "bmRemoteMed", strContent)
                End Select
                            
            'then clear the variable
                strContent = ""
                strPrefix = ""
            
            Case vbFormFeed
                Exit Sub
            Case Else
                strContent = strContent & Right(par.Range.Text, Len(par.Range.Text) - Len(a(0)) - 1) & vbLf
        End Select
    Next
End Sub

Thank you both for you help. It is always appreciated.

You don't know what you don't know...