Help required to extract data in Word doc to Excel

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
Attachment 25501

Welcome to this forum Al. U can look here for a general idea.... http://www.vbaexpress.com/forum/show...ighlight=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

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.

Code:

---

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

---

Perhaps:

Code:

---

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

---

Well, that is a horrible Table in Word.


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

Code:

---

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

---

Both tables can be copied in 1 go:

Code:

---

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

---

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

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