Results 1 to 12 of 12
  1. #1
    New Lounger
    Join Date
    Jul 2012
    Posts
    7
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Copy data from Word to Excel

    Dear All

    I have a lot of word documents from which i want to copy particular data (2nd and 5th column) from the table in second page and paste it in excel (in row format). Can anyone help me build a macro or any program for the same.

    Thanks

  2. Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,913
    Thanks
    0
    Thanked 192 Times in 176 Posts
    hi sanver,

    The page on which the table occurs is inconsequential. What matters is which table in the document it is. Assuming it's the first table in the document, and all you're after is something from the first row in that table, try:
    Code:
    Sub GetWordTableData()
    Application.ScreenUpdating = False
    Dim StrFolder As String, StrFile As String, StrTxt As String
    Dim wdApp As Object, wdDoc As Object, bStrt As Boolean, Rng As Object
    Dim WkSht As Worksheet, LRow As Long, i As Long
    StrFolder = GetFolder
    If StrFolder = "" Then Exit Sub
    Set WkSht = ThisWorkbook.Sheets("Sheet1")
    LRow = WkSht.Cells.SpecialCells(xlCellTypeLastCell).Row
    ' Test whether Word is already running.
    On Error Resume Next
    bStrt = False ' Flag to record if we start Word, so we can close it later.
    Set wdApp = GetObject(, "Word.Application")
    'Start Excel if it isn't running
    If wdApp Is Nothing Then
      Set wdApp = CreateObject("Word.Application")
      If wdApp Is Nothing Then
        MsgBox "Can't start Word.", vbExclamation
        Exit Sub
      End If
      ' Record that we've started Word.
      bStrt = True
    End If
    On Error GoTo 0
    StrFile = Dir(StrFolder & "\*.doc", vbNormal)
    While StrFile <> ""
      LRow = LRow + 1
      Set wdDoc = wdApp.Documents.Open(Filename:=StrFolder & "\" & StrFile, AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
      With wdDoc.tables(1)
        'Get the first cell's text from B1
        Set Rng = .Cells(2, 1).Range
        With Rng
          .End = .End - 1
          StrTxt = .Text
        End With
        'Update Excel
        WkSht.Cells(LRow, 1).Value = StrTxt
        'Get the second cell's text from E1
        Set Rng = .Cells(5, 1).Range
        With Rng
          .End = .End - 1
          StrTxt = .Text
        End With
        'Update Excel
        WkSht.Cells(LRow, 2).Value = StrTxt
      End With
      'Close the Word file
      wdDoc.Close SaveChanges:=False
      StrFile = Dir()
    Wend
    If bStrt = True Then wdApp.Quit
    Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing: Set Rng = 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
    Last edited by macropod; 2012-07-09 at 00:39.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  4. #3
    New Lounger
    Join Date
    Jul 2012
    Posts
    7
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Dear Paul thanks a lot for your quick response. I am not aware how to calculate the table in the document. So i have attached to you a sample of the document (inspection report - 2 nos.). I have higlighted the columns which i would like to transfer to excel file. I have also attached the excel file to show you the sample, the format in which i would like to have. Thanks again for your efforts.

  5. #4
    New Lounger
    Join Date
    Jul 2012
    Posts
    7
    Thanks
    0
    Thanked 0 Times in 0 Posts
    file attachment
    Attached Files Attached Files

  6. #5
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,913
    Thanks
    0
    Thanked 192 Times in 176 Posts
    hi Sanver,

    Your workbook structure isn't conducive to this sort of processing. In a very short time the code would either start overwriting the 'Timescale Code' data, or it would have to continually shift that data down a row - very inefficient. The same (transposed) would apply if you used a column layout. Such a structure also isn't conducive the subsequent data extraction. I suggest to reconsider the layout. You could, for example, reserve columns A:Z for the 'NC Code' data and columns AA:AZ for the 'Timescale Code' data.

    FWIW, the data table is the 4th in the document.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  7. #6
    New Lounger
    Join Date
    Jul 2012
    Posts
    7
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Is it possible we can keep NC code in sheet 1 and timescale code sheet 2 of microsoft excel.
    As i am new, can you also guide me how to run the programe.

  8. #7
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,913
    Thanks
    0
    Thanked 192 Times in 176 Posts
    Yes,that's possible, though it does complicate the code a bit more. I'll have a go at it later and post some more code for you to play with.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  9. #8
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,913
    Thanks
    0
    Thanked 192 Times in 176 Posts
    Try the following:
    Code:
    Sub GetWordTableData()
    Application.ScreenUpdating = False
    Dim StrFolder As String, StrFile As String, StrFnd As String, StrTxt As String
    Dim wdApp As Object, wdDoc As Object, bStrt As Boolean
    Dim WkSht1 As Worksheet, WkSht2 As Worksheet
    Dim LRow As Long, i As Long, j As Long, TblRw As Long
    StrFolder = GetFolder
    If StrFolder = "" Then Exit Sub
    Set WkSht1 = ThisWorkbook.Sheets("Sheet1")
    Set WkSht2 = ThisWorkbook.Sheets("Sheet2")
    LRow = WkSht1.Cells.SpecialCells(xlCellTypeLastCell).Row
    ' Test whether Word is already running.
    On Error Resume Next
    bStrt = False ' Flag to record if we start Word, so we can close it later.
    Set wdApp = GetObject(, "Word.Application")
    'Start Excel if it isn't running
    If wdApp Is Nothing Then
      Set wdApp = CreateObject("Word.Application")
      If wdApp Is Nothing Then
        MsgBox "Can't start Word.", vbExclamation
        Exit Sub
      Else
      End If
      ' Record that we've started Word.
      bStrt = True
    End If
    On Error GoTo 0
    StrFile = Dir(StrFolder & "\*.doc", vbNormal)
    While StrFile <> ""
      Set wdDoc = wdApp.Documents.Open(Filename:=StrFolder & "\" & StrFile, AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
      With wdDoc.Tables(4)
        'Set the Excel output row counter
        LRow = LRow + 1
        StrTxt = Split(wdDoc.Name, ".")(0)
        WkSht1.Cells(LRow, 1).Value = StrTxt
        WkSht2.Cells(LRow, 1).Value = StrTxt
        'Get the first cell's text from B1
        TblRw = .Rows.Count
        For j = 2 To TblRw
          StrTxt = .Cell(j, 2).Range.Text
          StrTxt = Left(StrTxt, Len(StrTxt) - 2)
          If StrTxt = "" Then Exit For
          'Update Excel
          WkSht1.Cells(LRow, j).Value = StrTxt
          'Get the second cell's text from E1
          StrTxt = .Cell(j, 5).Range.Text
          StrTxt = Left(StrTxt, Len(StrTxt) - 2)
          'Update Excel
          WkSht2.Cells(LRow, j).Value = StrTxt
        Next
      End With
      'Close the Word file
      wdDoc.Close SaveChanges:=False
      StrFile = Dir()
    Wend
    If bStrt = True Then wdApp.Quit
    Set wdDoc = Nothing: Set wdApp = Nothing
    Set WkSht1 = Nothing: Set WkSht2 = 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
    Note: As before the macro runs from Excel.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  10. #9
    New Lounger
    Join Date
    Jul 2012
    Posts
    7
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Thanks paul for the efforts taken...l shall try it and give you the feed back.

  11. #10
    New Lounger
    Join Date
    Jul 2012
    Posts
    7
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Thanks a lot paul. Really saved a lot of time compiling the reports. The macro runs fine but with a small error. I selected the folder which contains the documents (131 word documents). It showed an error. I have attached the screen shot of the error. I gave OK in the error dialog box and i got the data for 124 files segregated in sheet1 and sheet 2 as requested. Anyhow the macro has done 95% of the work. Thanks again paul.
    Attached Images Attached Images

  12. #11
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,913
    Thanks
    0
    Thanked 192 Times in 176 Posts
    I cannot tell from your screenshot what that error message represents. If you press Help, or Ctrl-Break then OK, when it occurs, you should be able to get more info about it. The Ctrl-Break approach might take you back to the line of code that exibits the problem. If you check the workbook's contents at that point (after exiting the sub), you should also be able to see what file the problem occurred with. There may be an issue with that file's contents.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  13. #12
    New Lounger
    Join Date
    Jul 2012
    Posts
    7
    Thanks
    0
    Thanked 0 Times in 0 Posts
    i shall try...thanks again

Posting Permissions

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