![]() |
|
|||||||
|
|
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 |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
Exporting specific data fields from MS Word 2013 to a MS Excel 2013 spreadsheet
|
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 |
Macro: Exporting Data to a LEGIBLE Excel Spreadsheet
|
jeffcoleky | Word VBA | 6 | 05-08-2012 08:24 AM |