Consulting

Results 1 to 5 of 5

Thread: extracting from multiple word tables to excel sheet

  1. #1
    VBAX Newbie
    Joined
    Sep 2020
    Posts
    4
    Location

    extracting from multiple word tables to excel sheet

    Hi all,

    I have a code that extracts table cell values from multiple word docs into a single excel sheet.

    I have adjusted the code so it identifies the paragraph break (and line break) from word table cells and implement them into the excel cells. However, this works fine on my office 365 version I have at home but not the excel 2013 version I have at work.

    I want to adjust the code so it would be compatible for the office 2013 version for others to use (and I can't ask my office to purchase 365 just for this).

    My understanding is that the vba versions of 365 and 2013 are the same, so I don't understand why this doesn't work.

    any inputs?


    my code:
    Sub ImportWordTable()
    
    
    
    Dim oWord As Object
    Dim oDoc As Object
    Dim oTable As Object
    Dim oCell As Object
    Dim sPath As String
    Dim sFile As String
    Dim r As Long
    Dim c As Long
    Dim Cnt As Long
    
    
    
    
    Application.ScreenUpdating = False
    On Error Resume Next 'tells VBA to ignore errors
    Set oWord = GetObject(, "Word.Application")
    If Err Then
      Set oWord = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    sPath = "C:\folder" 'change the path accordingly
    If Right(sPath, 1) <> "" Then sPath = sPath & ""
    sFile = Dir(sPath & "*.doc")
    
    
    Cells.Clear
    
    
    Cells(1, 1).Value = "File Name"
    Cells(1, 1).Font.Bold = True
    Cells(1, 1).Font.Color = vbBlue
    Cells(1, 2).Value = "Contents -->"
    Cells(1, 2).Font.Bold = True
    Cells(1, 2).Font.Color = vbBlue
    
    
    r = 2 'starting row
    c = 2 'starting column
    Cnt = 0
    Do While Len(sFile) > 0
    
    
      Cnt = Cnt + 1
      Set oDoc = oWord.Documents.Open(sPath & sFile)
      If oDoc.Tables.Count > 0 Then
        Cells(r, c - 1).Value = sFile
        For Each oTable In oDoc.Tables
          For Each oCell In oTable.Range.Cells
    
    
            Cells(r, c).Value = Replace(oCell.Range.Text, Chr(13) & Chr(7), "")
            Cells(r, c).Value = Replace(oCell.Range.Text, "^p", vbCrLf) 'changes the paragraph break into vba code
            Cells(r, c).Value = Replace(oCell.Range.Text, "^l", vbCrLf) 'changes the line break into vba code
            Cells(r, c).Value = Replace(oCell.Range.Text, Chr(7), "") ' erases the 'button' that shows in the cell
            Cells(r, c).Value = Left(Cells(r, c).Value, Len(Cells(r, c).Value) - 1) 'erases that one paragraph break that shows in the end of each cell
            c = c + 1
          Next oCell
        Next oTable
        r = r + 1
        c = 2
      End If
      oDoc.Close SaveChanges:=False
      sFile = Dir
      DoEvents
    Loop
    Application.ScreenUpdating = True
    If Cnt = 0 Then
      MsgBox "No Word documents were found...", vbExclamation
    End If
    End Sub
    thanks!!
    Last edited by macropod; 12-27-2020 at 02:13 PM. Reason: Added code tags & formatting

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Other than:
    SaveChanges:=False
    which should just be:
    False,
    there is nothing about your code that could cause an error when used on different Office versions. What error(s) are you getting?
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    You need to be specific about your sheet reference...
    Sheets("Sheet1").Cells(1, 1)

    HTH. Dave
    edit: You may also want to trial this instead of all that other stuff
    Sheets("sheet1").Cells(r, c).Value = Application.WorksheetFunction.Clean(oCell.Range.Text)

  4. #4
    VBAX Newbie
    Joined
    Sep 2020
    Posts
    4
    Location
    Hi guys thanks for the comments. Sorry for the late reply as I had to try it out on both machines.


    Quote Originally Posted by macropod View Post
    What error(s) are you getting?

    the result is that the values are simply shown as a single continuous string, instead of including the paragraph breaks as intended. There was no error message shown.




    Quote Originally Posted by Dave View Post
    Sheets("sheet1").Cells(r, c).Value = Application.WorksheetFunction.Clean(oCell.Range.Text)

    I tried this but it did not have any impact. It could be used as an alternative to erasing the 'bullet points' (Chr(7)) but even it did not have any impact on bringing the paragraph breaks to the excel 2013 spreadsheet.

  5. #5
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

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