gather specfic Tables to one file

Ethen5155 · #1 11-13-2019, 03:42 PM

Hi all,

well i'm in bad situation in dealing with huge number of files for translation in docx files

i'm trying to find a code that can go through defined path folder by prompt window or anything else,

then copy the 4th table as shown below

and gather all of tables to the first file and separate between them by a paragraph mark

i have attached sample files for before and after

and here is code that can copy specific table to a new document but i couldn't make it go through multiple files with the separator and when it copy a table it doesn't copy the format, table and cell sizes well

Quote:

Sub ExtractSpecificTables()
Dim objTable As Table
Dim objDoc As Document
Dim objNewDoc As Document
Dim objRange As Range
Dim strTable As String

strTable = InputBox("Enter the table number: ")
Set objDoc = ActiveDocument
Set objNewDoc = Documents.Add

objDoc.Tables(strTable).Range.Select
Selection.Copy

Set objRange = objNewDoc.Range
objRange.Collapse Direction:=wdCollapseEnd
objRange.PasteSpecial DataType:=wdPasteRTF

End Sub

Many thanks in advance

Cheers

Cross - Posting:gather all Tables to one file

gmayor · #2 11-14-2019, 05:50 AM

Duplicated post at gather all Tables to one file

Ethen5155 · #3 11-14-2019, 01:13 PM

Solved - Done

Quote:

Sub GetTables()

Dim strFile As String
Dim strPath As String
Dim oDoc As Document, oTarget As Document
Dim oRng As Range
Dim fDialog As FileDialog
Dim i As Integer
Dim oCC As ContentControl
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.TITLE = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "" Then strPath = strPath + ""
End With
i = 1
strFile = Dir$(strPath & "*.do?")
While strFile <> ""
If i = 1 Then
Set oTarget = Documents.Add(Template:=strPath & strFile)
For Each oCC In oTarget.ContentControls
oCC.LockContentControl = False
Next oCC
oTarget.Range.Text = ""
End If
Set oDoc = Documents.Open(FileName:=strPath & strFile, AddToRecentFiles:=False)
If oDoc.Tables.Count > 3 Then
oDoc.Tables(4).Range.Copy
Set oRng = oTarget.Range
oRng.Collapse 0
oRng.PasteAndFormat wdFormatOriginalFormatting
oRng.End = oTarget.Range.End
oRng.Collapse 0
oRng.Text = vbCr
End If
oDoc.Close SaveChanges:=wdDoNotSaveChanges
i = i + 1
DoEvents
strFile = Dir$()
Wend
lbl_Exit:
Set oDoc = Nothing
Exit Sub
End Sub

Emby · #4 01-29-2020, 05:04 AM

Dear Graham,

The above macro is also suitable to me but it does not work on word 2000 at my office. As word 2000 does not accept "Dim oCC As ContentControl", how to convert the above macro to word 2000 version to avoid 'User Defined Type Not Defined' error appeared?

Guessed · #5 01-29-2020, 02:30 PM

Emby

Word 2000 doesn't support Content Controls so you can delete that line and these three will also need to be removed. This won't effect the rest of the code.

For Each oCC In oTarget.ContentControls
oCC.LockContentControl = False
Next oCC

Emby · #6 01-29-2020, 03:41 PM

Thanks for Andrew explaining to me.

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
VBA to gather data from one workbook and pasting it in a data set	lwbarnes	Excel Programming	1	11-02-2016 07:05 PM
Problem with saving Word file that is connected to Excel files that uses Powerpivot tables, charts	Paul-NYS	Office	2	08-24-2016 06:00 AM
import tables from an Excel file, but from different sheets	rabit2	Word	2	04-20-2016 05:58 AM
On Open MsgBox for use in Template sent out to colleagues to gather information	Lancashire Lad	Word VBA	2	10-26-2015 10:22 AM
excel cannot open the file .xlsx because the file format or file extension is not val	teddysika	Excel	1	11-22-2012 06:06 AM