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 = FalseDim fldpathDim fld, fil As ObjectDim appWord
As Word.ApplicationDim docWord As Word.DocumentDim tableWord As Word.TableDim
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 = TrueFor 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") ThenSet 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.CloseEnd IfNext fil
appWord.Quit
Sheets(1).SelectSet tableWord = NothingSet docWord = NothingSet 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.
