![]() |
|
|
Thread Tools | Display Modes |
#4
|
||||
|
||||
![]()
Try the following Excel macro. It assumes the 'find' list is in column A of Sheet1 and, if you're using wildcards for a particular Find expression, you'll have TRUE in column B on that row.
The macro includes a folder browser, so all you need do is run the macro and select the folder to process. The macro will add a new sheet and output all matches it finds on that sheet. You will need to set a Reference to the Microsoft Word Object Library in the Excel VBE. Code:
Sub DataFind() Application.ScreenUpdating = False Dim strFolder As String 'Get the folder to process strFolder = GetFolder If strFolder = "" Then Exit Sub Dim strFile As String, strFnd As String, strOut As String Dim wdApp As New Word.Application, wdDoc As Word.Document wdApp.Visible = True Dim xlShtIn As Worksheet, xlShtOut As Worksheet, i As Long, j As Long 'Define Data sheet & create & initialize the output sheet Set xlShtIn = Sheets("Sheet1"): Set xlShtOut = Sheets.Add: j = 1 xlShtOut.Range("A1").Value = "Document" xlShtOut.Range("B1").Value = "Operator" xlShtOut.Range("C1").Value = "Text" 'Process each document in the folder strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc 'Process each word from the list in the source sheet For i = 2 To xlShtIn.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row strFnd = xlShtIn.Range("A" & i) With .Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = strFnd .MatchWildcards = (xlShtIn.Range("B" & i) = True) .Forward = True .Wrap = wdFindStop .Format = False .Execute End With 'Send the matches to the output sheet Do While .Find.Found j = j + 1 xlShtOut.Range("A" & j).Value = strFile xlShtOut.Range("B" & j).Value = strFnd xlShtOut.Range("C" & j).Value = Replace(Split(.Paragraphs(1).Range.Text, vbCr)(0), vbTab, " ") .Start = .Paragraphs(1).Range.End .Find.Execute Loop End With Next i .Close SaveChanges:=False End With strFile = Dir() Wend ' Release object memory wdApp.Quit Set wdDoc = Nothing: Set wdApp = Nothing: Set xlShtIn = Nothing: Set xlShtOut = Nothing Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
data extraction, regex |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
Labyrinth | Word | 7 | 07-19-2016 01:35 PM |
Exporting quiz scores from powerpoint to excel spreadsheet/word | rjagile | PowerPoint | 1 | 02-08-2016 02:26 PM |
Find and replace in word document repeated for every item in excel spreadsheet | Daniell | Word | 1 | 02-17-2015 04:38 AM |
Trying to import specific data from one spreadsheet to another, without matching rows | Wynka | Excel | 0 | 11-26-2014 09:33 AM |
![]() |
jeffcoleky | Word VBA | 6 | 05-08-2012 08:24 AM |