gather specfic Tables to one file

Ethen5155 · #1 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

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