Results 1 to 6 of 6

Thread: gather all Tables to one file

  1. #1

    gather specific Tables to one file

    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

    Many thanks in advance

    Attached Files Attached Files
    Last edited by Ethen5155; 11-13-2019 at 03:49 PM.

  2. #2
    any help would be appreciated, i got a 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.

    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


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

    End Sub

  3. #3
    What you require is fairly straightforward it is just a matter of looping through the files and pasting the tables into a new document based on one of the files (without its content) e.g. as follows. The only complication is the locked content controls in the document used as template.

    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
                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
            strFile = Dir$()
        Set oDoc = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes

  4. #4
    Dear Graham,

    Many thanks for your reply. but i tried your code and it seems doesn't work to me.

    i got a window to select the folder then i choose it but no thing happened after that!!

    did you test it on my attached files?

    looking forward to your reply and many thanks in advance for your generous help

  5. #5
    This forum seems to randomly remove line breaks. The first line
    Sub GetTables()Dim strFile As String
    should be
    Sub GetTables()
    Dim strFile As String
    and yes it works with your example files - attached.
    Attached Files Attached Files
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes

  6. #6
    yes i know about the line break but it didn't work to me until i tried on another Labtop, i guess my office has an issue.

    3000 Thousands thanks Graham, you made my day


Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts