|
11-14-2019, 01:13 PM
|
|
Novice
|
|
Join Date: Nov 2019
Posts: 5
|
|
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
|
|