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

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.

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 :)

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!

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

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

Select allOpen in new window

I suggest that you post a question in community support asking that the offending comment to be deleted or edited.