?
Solved

Regex in MS word Macro, how to copy matching groups.

Posted on 2010-01-07
8
Medium Priority
?
320 Views
Last Modified: 2013-11-25
I'm using macros to strip some info from some documents. See attached.

However, i only want to copy the matching group, that would be the birth date in this case. I do i proceed to do this?


With rng.Find
                Text = "born ([0-9]{2}-[0-9]{2}-[0-9]{4})"
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchAllWordForms = False
                .MatchSoundsLike = False
                .MatchWildcards = True
                .Forward = False
                
              End With
              Selection.Find.Execute
              If Selection.Text <> "" Then
                Selection.Copy
              End if

Open in new window

0
Comment
Question by:DerkArts
  • 3
  • 2
  • 2
7 Comments
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 26200374
Instead of copying, why not dump the text into a variable:


              Selection.Find.Execute
              If Selection.Text <> "" Then
                SomeVar = Trim(Replace(Replace(Replace("born", LCase(Selection.Text), ""), "(", ""), ")", "")
              End if


Now, SomeVar contains just the date literal, which you can do whatever you need with.
0
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 2000 total points
ID: 26200476
Do the find for the data only within the range that has just been found.

Sub CopyLastBornDate()
    Dim rng As Range
    
    Set rng = ActiveDocument.Range
    With rng.Find
        .Text = "born ([0-9]{2}-[0-9]{2}-[0-9]{4})"
        .Wrap = wdFindContinue
        .MatchWildcards = True
        .Forward = False
         If .Execute Then
            .Text = "([0-9]{2}-[0-9]{2}-[0-9]{4})"
            If .Execute Then
                rng.Copy
            End If
        End If
    End With
End Sub

Open in new window

0
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 26200506
GrahamSkan said:
>>Do the find for the data only within the range that has just been found.

Someday I aspire to be as smart as Graham :)
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 3

Author Comment

by:DerkArts
ID: 26202620
GrahamSkan, this looks good, could you please tell me how to use this in the following regex:
.Text = "([0-9]{2}-[0-9]{2}-[0-9]{2}) until  ([0-9]{2}-[0-9]{2}-[0-9]{2})"

Where i need to match two parts of the regex.

Furthermore, can you explain to me how to deselect something. like Selection.Deselect or something.

Thank you!
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 26203383
Your string would find some text like "07-01-2010 until 31-01-2010".  Do you need something different?

I avoid using the Selection object. You can't deselect without selecting something else. However, you can collapse the selection to its beginning or end.

Selection.Collapse wdCollapseStart
or
Selection.Collapse wdCollapseEnd

0
 
LVL 3

Author Comment

by:DerkArts
ID: 26203624
Yes, what i am doing is pasting all the info into excel. However this is not going smoothly. I'll just paste the entire macro.

Maybe you can help me get the entire thing to work. Ill up the points to 500 for this.
Here's the code (i know i should use functions but i just want this to work quickly)

Public Sub ClearClipBoard()
    Dim oData As New DataObject 'object to use the clipboard
     
    oData.SetText Text:=Empty 'Clear
    oData.PutInClipboard 'take in the clipboard to empty it
End Sub


'
' 
' 
'
Sub FindReplaceAllDocsInFolder()
Dim i As Integer
Dim doc As Document
Dim rng As Range
Dim oWbk As Workbook
Dim sFil As String
Dim sPath As String
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")

If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If
Set t = oXL.ActiveWorkbook
t.Sheets("Blad1").Range("A65536").End(xlUp).Offset(1, 0).Select

sPath = "C:\path\to\files\" 'location of files
ChDir sPath
sFil = Dir("*.doc") 'change or add formats
ClearClipBoard
Do While sFil <> "" 'will start LOOP until all files in folder sPath have been looped through Set oWbk = Workbooks.Open(sPath & "\" & sFil) 'opens the file
   t.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Select
    Set doc = Documents.Open(sPath & "\" & sFil)
              
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.HomeKey
    With Selection.Find
                .Text = "([0-9]{1;2})e operatie"
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchAllWordForms = False
                .MatchSoundsLike = False
                .MatchWildcards = True
               
                 .Forward = False
                  If .Execute Then
                    .Text = "([0-9]{1;2})"
                    If .Execute Then
                        Selection.Copy
                        t.ActiveSheet.Paste
                    End If
                End If
              End With
             
            
    
    Selection.HomeKey
    ClearClipBoard
    t.ActiveSheet.Cells(oXL.Selection.Row, oXL.Columns.Count).End(xlToLeft).Offset(, 1).Select
    With Selection.Find
                .Text = "([0-9]{2}-[0-9]{2}-[0-9]{2;4}) tot en met ([0-9]{2}-[0-9]{2}-[0-9]{2;4})"
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchAllWordForms = False
                .MatchSoundsLike = False
                .MatchWildcards = True
               
                 .Forward = True
                  If .Execute Then
                    .Text = "([0-9]{2}-[0-9]{2}-[0-9]{2;4})"
                    If .Execute Then
                        Selection.ClearFormatting
                        Selection.Copy
                        t.ActiveSheet.Paste
                        t.ActiveSheet.Cells(oXL.Selection.Row, oXL.Columns.Count).End(xlToLeft).Offset(, 1).Select
                        .Text = "([0-9]{2}-[0-9]{2}-[0-9]{2;4})"
                         If .Execute Then
                            Selection.ClearFormatting
                            Selection.Copy
                            t.ActiveSheet.Paste
                        End If
                    End If
                End If
              End With
             
              
          
    Selection.HomeKey
    ClearClipBoard
    t.ActiveSheet.Cells(oXL.Selection.Row, oXL.Columns.Count).End(xlToLeft).Offset(, 1).Select
    With Selection.Find
                .Text = "geboren ([0-9]{2}-[0-9]{2}-[0-9]{4})"
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchAllWordForms = False
                .MatchSoundsLike = False
                .MatchWildcards = True
               
                 .Forward = True
                  If .Execute Then
                    .Text = "([0-9]{1;2})"
                    If .Execute Then
                        Selection.ClearFormatting
                        
                        Selection.Copy
                        t.ActiveSheet.Paste
                    End If
                End If
              End With
             
              
           
            t.ActiveSheet.Cells(oXL.Selection.Row, oXL.Columns.Count).End(xlToLeft).Offset(, 1).Select
            t.ActiveSheet.ActiveCell = sFil
            t.ActiveSheet.ActiveCell = "*****"
            doc.Save
            doc.Close

            Set rng = Nothing
            Set doc = Nothing
        
    


sFil = Dir
Loop ' End of LOOP
End Sub

Open in new window

0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 26206015
I suggest that you post a question in community support asking that the offending comment to be deleted or edited.
0

Featured Post

NFR key for Veeam Agent for Linux

Veeam is happy to provide a free NFR license for one year.  It allows for the non‑production use and valid for five workstations and two servers. Veeam Agent for Linux is a simple backup tool for your Linux installations, both on‑premises and in the public cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Word is a program we have all encountered at some point, but very few of us have dug deep into its full scope of features, let alone customized it to suit our needs. Luckily making the ribbon (aka toolbar, first introduced in Word 2007) wo…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This video walks the viewer through the process of creating a watermark for their document, customizing it, and saving it for viewing/printing needs.
In a previous video Micro Tutorial here at Experts Exchange (http://www.experts-exchange.com/videos/1358/How-to-get-a-free-trial-of-Office-365-with-the-Office-2016-desktop-applications.html), I explained how to get a free, one-month trial of Office …

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question