Extract Document ID and description from header in multiple Word documents and paste in new word doc

venkat_m · #1 05-22-2020, 11:44 PM

Problem Statement: Require VBA Code - Need to Extract Document ID and description from header in multiple MS Word documents and should be automatically populated in a separate word document which has columns document type, Document ID, location of evidence, revision and description.

Multiple MS Word documents Folder location:

C:\Users\MURALV05\Desktop\Value Creation\Value Creation\1. SUPPLIER EVALUATION & AGREEMENTS

C:\Users\MURALV05\Desktop\Value Creation\Value Creation\2. PLANNING

C:\Users\MURALV05\Desktop\Value Creation\Value Creation\3. DESIGN INPUT

C:\Users\MURALV05\Desktop\Value Creation\Value Creation\4. DESIGN OUTPUT

C:\Users\MURALV05\Desktop\Value Creation\Value Creation\5. DESIGN VERIFICATION

C:\Users\MURALV05\Desktop\Value Creation\Value Creation\8. RISK MANAGEMENT

C:\Users\MURALV05\Desktop\Value Creation\Value Creation\10. DESIGN CHANGE HISTORY LOG

macropod · #2 05-23-2020, 03:28 AM

Cross-posted at: VBA Code to extract Document ID and Description from header in multiple MS Word documents and automatic populated in a separate word document - Stack Overflow
For cross-posting etiquette, please read: Excelguru Help Site - A message to forum cross posters

venkat_m · #3 05-23-2020, 03:57 AM

Code:

Sub ExtractTablesFromMultiDocs()
  Dim objTable As Table
  Dim objDoc As Document, objNewDoc As Document
  Dim objRange As Range
  Dim strFile As String, strFolder As String
 
  '  Initialization
  strFolder = InputBox("C:\Users\MURALV05\Desktop\Value Creation\Value Creation: ")
  strFile = Dir(strFolder & "" & "*.docx", vbNormal)
 
  Set objNewDoc = Documents.Add
 
  '  Process each file in the folder.
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=strFolder & "" & strFile)
    Set objDoc = ActiveDocument
 
    For Each objTable In objDoc.Tables
      objTable.Range.Select
      Selection.Copy
 
      Set objRange = objNewDoc.Range
      objRange.Collapse Direction:=wdCollapseEnd
      objRange.PasteSpecial DataType:=wdPasteRTF
      objRange.Collapse Direction:=wdCollapseEnd
      objRange.Text = vbCr
    Next objTable
 
    objDoc.Save
    objDoc.Close
    strFile = Dir()
  Wend
 
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to extract bookmarked data from Word document and insert into another Word Document	VStebler	Word VBA	3	05-03-2018 05:02 PM
Need to extract e-mail addresses from lots of word documents	zebedee398	Word VBA	0	12-01-2017 03:29 AM
Switch between multiple Word documents within the same Word document	kai	Word VBA	2	11-20-2017 10:13 PM
batch extract all tables in multiple word documents	ZaidaBa	Word Tables	3	05-08-2017 10:22 PM
Extract Data from Word Documents	hiwire03	Word VBA	3	01-29-2016 09:19 PM