Consulting

Results 1 to 7 of 7

Thread: Help required to extract data in Word doc to Excel

  1. #1
    VBAX Newbie
    Joined
    Nov 2019
    Posts
    2
    Location

    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
    test Inspection sheet.docx

  2. #2
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    618
    Location
    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

  3. #3
    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
    Attached Files Attached Files
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,917
    Location
    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
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,657
    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
    Last edited by snb; 11-29-2019 at 08:51 AM.

  6. #6
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,657
    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

  7. #7
    VBAX Newbie
    Joined
    Nov 2019
    Posts
    2
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •