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

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