On Tuesday, November 28, 2017 at 8:08:59 PM UTC+5:30, John C wrote:
> I am looking for a Macro to export the contents of every table in a Word
> document(s) and move this content to Excel. Along with pulling the contents
> of the tables however, I would like the titles of each of these tables to be
> exported as well. The Word document(s) are formatted in a table of contents
> style, with the "titles" of the tables being the headers of each section of
> the table of contents. Some of the sections in the table of contents have no
> table within the section, in which case, I would like the macro to move on
> from that section if there is no table within it. I am trying to have this
> Macro work for multiple Word documents in a single folder. The great news is
> that I already have a Macro currently working that does everything I asked
> above EXCEPT for pull the title of each table section. Below is the Macro I
> am currently using. Any help is greatly appreciated!! (THE MACRO I AM
> CURRENTLY USING I FOUND ON THIS FORUM AND HAS WORKED GREATLY, JUST NEED THE
> SLIGHT ADJUSTMENT OF BEING ABLE TO PULL THE HEADERS/TITLES OF EACH TABLE)
>
>
>
> Sub import_word_table_to_excel()
> Application.DisplayAlerts = False
> Application.ScreenUpdating = False
> Dim fldpath
> Dim fld, fil As Object
> Dim appWord As Word.Application
> Dim docWord As Word.Document
> Dim tableWord As Word.Table
> Dim sdoc As String
>
>
> ' use to choose the folder having word documents
>
> Application.FileDialog(msoFileDialogFolderPicker).Title = "Choose Folder"
> Application.FileDialog(msoFileDialogFolderPicker).Show
> fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
> & "\"
> Set fso = CreateObject("scripting.filesystemobject")
> Set fld = fso.getfolder(fldpath)
>
> Set appWord = New Word.Application
> appWord.Visible = True
> For Each fil In fld.Files
>
> ' browse word documents in a folder
>
>
> If UCase(Right(fil.Path, 4)) = UCase(".doc") Or UCase(Right(fil.Path, 5)) =
> UCase(".docx") Then
> Set docWord = appWord.Documents.Open(fil.Path)
> For Each tableWord In docWord.Tables
> ' copy word tables
> tableWord.Range.Copy
> ' paste it on sheet 1 of excel file
> Sheets(1).Paste Destination:=Sheets(1).Range("A65356").End(xlUp).Offset(1, 0)
> Next
> docWord.Close
> End If
> Next fil
>
>
> appWord.Quit
> Sheets(1).Select
> Set tableWord = Nothing
> Set docWord = Nothing
> Set appWord = Nothing
>
> Application.DisplayAlerts = True
> Application.ScreenUpdating = True
>
> End Sub
--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at https://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.
