#1
|
|||
|
|||
Extract Data from Word Documents
I am using Office 2013 64 bit.
I have many word documents in the undermentioned format: 1.Heading A blah blah 2.Heading B blah blah blah 3.Heading C blah blah blah What I am trying to achieve is a document that extracts contents based on the Headings and consolidates then into a separate file. So I would have three files: File X : Heading A from File 1 Heading A from File 2 Heading A from File 3 .. File Y : Heading B from File 1 Heading B from File 2 Heading B from File 3 .. File Z : Heading C from File 1 Heading C from File 2 Heading C from File 3 .. If the same can be reversed it would we awesome. Thanks in AdvanceI am using Office 2013 64 bit. I have many word documents in the undermentioned format: 1.Heading A blah blah 2.Heading B blah blah blah 3.Heading C blah blah blah What I am trying to achieve is a document that extracts contents based on the Headings and consolidates then into a separate file. So I would have three files: File X : Heading A from File 1 Heading A from File 2 Heading A from File 3 .. File Y : Heading B from File 1 Heading B from File 2 Heading B from File 3 .. File Z : Heading C from File 1 Heading C from File 2 Heading C from File 3 .. If the same can be reversed it would we awesome. Thanks in Advance, |
#2
|
||||
|
||||
Quote:
Your reversal request is ambiguous. Data extraction doesn't delete the headings from the source documents, so there should be nothing to reverse.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
The three files are just an example. What I need are a X number documents (each containing just ONE heading (Level 1) alongwith its contents) consolidated from Y number of documents.
Please ignore the reversal part for now. |
#4
|
||||
|
||||
Try the following macro:
Code:
Sub CollateDocumentHeadings() Application.ScreenUpdating = False Dim strFolder As String, strFile As String, i As Long, Rng As Range Dim wdDocSrc As Document, wdDocTmp As Document, wdDocOut As Document strFolder = GetFolder If strFolder = "" Then Exit Sub Set wdDocTmp = Documents.Add strFile = Dir(strFolder & "\*.docx", vbNormal) While strFile <> "" i = 0 If ThisDocument.FullName <> strFolder & "\" & strFile Then Set wdDocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDocSrc With .Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Replacement.Text = "" .Format = True .Style = wdStyleHeading1 .Execute End With Do While .Find.Found i = i + 1 Set Rng = .Duplicate With Rng .End = .End - 1 End With With wdDocTmp If .Sections.Count < i Then .Range.InsertAfter vbCr .Sections.Add Range:=.Characters.Last, Start:=wdSectionNewPage End If .Sections(i).Range.Characters.Last.InsertBefore Rng.Text & vbTab & strFile & vbCr End With .Collapse wdCollapseEnd .Find.Execute Loop End With .Close SaveChanges:=False End With End If strFile = Dir() Wend With wdDocTmp .SaveAs2 FileName:=strFolder & "\Headings Master List.docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False For i = 1 To .Sections.Count Set Rng = .Sections(i).Range With Rng .MoveEnd wdCharacter, -1 End With Set wdDocOut = Documents.Add(Visible:=False) With wdDocOut .Range.FormattedText = Rng.FormattedText .SaveAs FileName:=strFolder & "\Headings (" & i & ") List.docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False .Close SaveChanges:=True End With Next End With Set wdDocSrc = Nothing: Set wdDocTmp = Nothing: Set wdDocOut = 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, extract, word 2013 |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Extract the filter data | Sandhya | Excel Programming | 2 | 10-25-2015 09:02 AM |
Extract Excel Data from Chart in Word | cillianmccolgan | Word | 1 | 08-15-2014 01:42 AM |
How to extract data from Excel database to create word report for each patient (row) | nightale | Word | 3 | 07-06-2014 04:17 PM |
How to extract two different output documents from 1 master document? | wimvanrompuy | Word | 3 | 06-20-2014 06:43 AM |
How to Extract key data from word | iliauk | Word | 3 | 11-08-2013 04:37 PM |