• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 323
  • Last Modified:

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

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
DerkArts
Asked:
DerkArts
  • 3
  • 2
  • 2
1 Solution
 
Patrick MatthewsCommented:
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
 
GrahamSkanRetiredCommented:
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
 
Patrick MatthewsCommented:
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
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
DerkArtsAuthor Commented:
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
 
GrahamSkanRetiredCommented:
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
 
DerkArtsAuthor Commented:
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
 
GrahamSkanRetiredCommented:
I suggest that you post a question in community support asking that the offending comment to be deleted or edited.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

  • 3
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now