View Single Post
 
Old 05-23-2020, 03:57 AM
venkat_m venkat_m is offline Windows 10 Office 2016
Novice
 
Join Date: May 2020
Posts: 2
venkat_m is on a distinguished road
Default VBA Code needs correction as per my problem statement

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

Last edited by macropod; 05-23-2020 at 03:59 AM. Reason: Added code tags
Reply With Quote