PDA

View Full Version : [SOLVED:] Help required to extract data in Word doc to Excel



alw94
11-28-2019, 09:44 AM
Afternoon All,


First post and a request for help straight away. Hopefully,this ok to post.


Disclaimer – Although I’ve used Excel for years for variousreasons, I’ll admit my knowledge of how it works is basic to say the least. Wehave a few issues that I need help to fix, so I may end up creating separate posts.Anyway, here is a start.


My situation is that we have inspection sheets that our Teamuse that have been created in word by another Member of my Team. The sheets havea couple of tables in which data has been entered. I need to extract this dataand place it in an excel spreadsheet. To date there are approx 800 sheets thatI need to work through.


From Googling, I think, I can see that this is possible byusing VBA and macro. I’ve tried working through forum posts and youtubetutorials and to my shame haven’t really been able to extract any data. Therecould be many reasons for this or it could be that I am such a muppet that theproblems is with me. This is why I’ve decided to admit my shortcomings and askfor help. No doubt, even with you good People helping, I’ll get it wrong andhave to ask some idiot questions.


I’ve attached a copy of the inspection sheet we use. I’vedeleted the text from the original to protect the innocent but highlighted inyellow the cells from which I want to extract text. Hopefully, this will helpbut if there’s anything else you or I need, let me know.


Going forward, I’m changing the sheets to excel documents asI’m assuming this will make it easier. Is this correct?


Can I also run a macro to automatically PDF all the sheets?Can this be run in the same macro when extracting the data? If this makes itcomplicated, please ignore this part.


So, any help appreciated. I am really hoping that I canlearn how to do this as I think we’ll be needing to do more of the same withother information.


Many thanks
Al
25501

Dave
11-28-2019, 03:27 PM
Welcome to this forum Al. U can look here for a general idea.... http://www.vbaexpress.com/forum/showthread.php?65937-VBA-Excel-To-find-word-in-Microsoft-Word-Table-and-copy-Offsets-to-Excel-Cells&highlight=table
You need to be specific... U have 800 Word docs, XL files, or both? Are they all in 1 folder? All data to 1 XL file? What & Where exactly is the data and where exactly do U want to put it? HTH. Dave

gmayor
11-28-2019, 11:29 PM
Word tables with merged cells are a pain to process, however the attached Word add-in (not yet published on my web site) will identify the cell indices of the cells in such a table to make it simpler to address the cell content directly using Word VBA. e.g. running the code from Outlook, you can grab the contents of the required cells and write them to your workbook. The following example assumes your document is open and active in Word. In practice you would open the document(s) from the macro to process them.


Dim wdApp As ObjectDim wdDoc As Object
Dim oCell As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdDoc = wdApp.activedocument ' or open the document
Set oCell = wdDoc.Tables(1).Range.Cells(3).Range
oCell.End = oCell.End - 1
'do something with ocell.text
MsgBox "Site Name is " & oCell.Text

macropod
11-29-2019, 02:06 AM
Perhaps:

Option Explicit
Sub GetTableData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim strFolder As String, strFile As String, WkSht As Worksheet
Dim c As Long, r As Long, i As Long, j As Long
strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
Set WkSht = ActiveSheet
r = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
r = r + 1: c = 1
WkSht.Cells(r, c).Value = Split(strFile, ".docx")(0)
With wdDoc
With .Tables(1)
For i = 2 To 4 Step 2
For j = 2 To 4
c = c + 1
WkSht.Cells(r, c).Value = Split(.Cell(j, i).Range.Text, vbCr)(0)
Next
Next
For i = 2 To 4 Step 2
For j = 6 To 10
c = c + 1
WkSht.Cells(r, c).Value = Split(.Cell(j, i).Range.Text, vbCr)(0)
Next
Next
For j = 14 To 22
For i = 3 To 5
c = c + 1
WkSht.Cells(r, c).Value = Split(.Cell(j, i).Range.Text, vbCr)(0)
Next
Next
End With
With .Tables(2)
For j = 2 To 7
For i = 3 To 5
c = c + 1
WkSht.Cells(r, c).Value = Split(.Cell(j, i).Range.Text, vbCr)(0)
Next
Next
For j = 9 To 11
For i = 3 To 5
c = c + 1
WkSht.Cells(r, c).Value = Split(.Cell(j, i).Range.Text, vbCr)(0)
Next
Next
End With
.Close SaveChanges:=False
End With
strFile = Dir()
Wend
ErrExit:
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

snb
11-29-2019, 08:12 AM
Well, that is a horrible Table in Word.


Use this macro in Excel while your Word document is open:


Sub M_snb()
GetObject(, "Word.application").activedocument.tables(1).Range.Copy

With Sheet2
.Paste .Cells(1)

GetObject(, "Word.application").activedocument.tables(2).Range.Copy
.Paste .Cells(24, 1)

.Cells.UnMerge
.Range("A1, A5, A11:A14,A24:A25,A32").EntireRow.Delete
.UsedRange.SpecialCells(4).Delete -4159
.Rows("9:16").Insert
.Range("C1:D8").Cut .Cells(9, 1)
.Columns.AutoFit
End With
End Sub

snb
11-30-2019, 06:16 AM
Both tables can be copied in 1 go:


Sub M_snb()
With GetObject(, "Word.Application").ActiveDocument
.Range(.Tables(1).Range.Start, .Tables(2).Range.End).Copy
End With

With ActiveSheet
.Paste .Cells(1)
.Cells.UnMerge
.Range("A1, A5, A11:A14,A24:A27,A34").EntireRow.Delete
.UsedRange.SpecialCells(4).Delete -4159
.Rows("9:16").Insert
.Range("C1:D8").Cut .Cells(9, 1)
.UsedRange.Borders.LineStyle = -4142
.Columns.AutoFit
End With
End Sub

alw94
12-02-2019, 08:49 AM
Hi Folks

Many thanks for your replies, I appreciate that. Apologies for no coming back sooner.

So, just to clarify I have approx. 800 word docs that I would place in one specific folder. I would like the results to populate one excel spreadsheet. If and when I can get all text in the spreadsheet I can then use as I need to.

Apologies on the document, it wasn't created with this in mind. TBH it's doubtful we'd have made it better anyway. I am creating an excel version so suggestions welcome on what would make it better.

I'll start to have a go with your suggestions over the next day or two. Prepare yourself for the idiot questions.

Cheers

alw94
02-11-2020, 04:34 AM
Hello again Folks

It's been quite a while since you posted to help answer my query and I kept meaning to come back and thank you. I've used Macropod's code to extract what I want and even changed the code to extract from other sheets too. I think for now it's good enough for what we need.

Thanks again for all your posts and help.

Cheers