locked
How to get specific lines from first page of word document to excel using macro vba? RRS feed

  • Question

  • Hi all,

    I am newbie to Excel. Can anybody help me in fetching specific data from first page of word document.

    Ex: In "C:\Test\Name1.doc", I have text like "Good Person Score=4432" & "Bad Person Score=1234" in first page. So, I need to get "Good Person Score=4432" this data to an Excel using macro vba. Can anybody help me please.


    sammy

    Friday, July 24, 2015 6:39 AM

Answers

  • Hi Sammy,

      If wrdRng.Find.Execute(FindText:="Application ID:[0-9]{1,}", MatchWildcards:=True) = True Then ' I AM NOT GETTING WHAT I AM WANTING EVEN THOUGH I WROTE THIS LINE.
                     MsgBox "Text not found!", vbExclamation
                     End If
       strText = wrdRng.Text

    The value of strText is what you want (Application ID:XXX), you could debug the code and check its value.

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Wednesday, July 29, 2015 3:27 AM

All replies

  • Hi all,

    I am newbie to Excel. Can anybody help me in fetching specific data from first page of word document.

    Ex: In "C:\Test\Name1.doc", I have text like "Good Person Score=4432" & "Bad Person Score=1234" in first page. So, I need to get "Good Person Score=4432" this data to an Excel using macro vba. Can anybody help me please.


    sammy

    Friday, July 24, 2015 4:54 AM
  • The right forum for this question is Excel for Developers, a moderator will move it for you for a better assistance. This forum is for VB.net code issues.

    Fouad Roumieh

    Friday, July 24, 2015 5:33 AM
  • Oops..!! Thank you Roumeih. 

    sammy

    Friday, July 24, 2015 6:39 AM
  • Code could look like this. It uses late binding; you don't have to set a reference to the Word object library.

    Sub GetData()
        Dim wrdApp As Object
        Dim wrdDoc As Object
        Dim wrdRng As Object
        Dim blnStart As Boolean
        Dim strText As String
     
        ' Try to get instance of Word
        On Error Resume Next
        Set wrdApp = GetObject(Class:="Word.Application")
        If wrdApp Is Nothing Then
            Set wrdApp = CreateObject(Class:="Word.Application")
            If wrdApp Is Nothing Then
                MsgBox "Failed to start Word!", vbExclamation
                Exit Sub
            End If
            blnStart = True
        End If
        On Error GoTo ErrHandler
     
        ' Open document
        Set wrdDoc = wrdApp.Documents.Open("C:\Test\Name1.doc")
        ' Refer to its content
        Set wrdRng = wrdDoc.Content
        ' Try to find text
        If wrdRng.Find.Execute(FindText:="Good Person Score=[0-9]{1,}", MatchWildcards:=True) = False Then
            MsgBox "Text not found!", vbExclamation
            GoTo ExitHandler
        End If
        ' Assign text to variable
        strText = wrdRng.Text
        ' Do something with the text, e.g.
        Range("B3").Value = strText
     
    ExitHandler:
        On Error Resume Next
        wrdDoc.Close SaveChanges:=False
        If blnStart Then
            wrdApp.Quit SaveChanges:=False
        End If
        Exit Sub
     
    ErrHandler:
        MsgBox Err.Description, vbExclamation
        Resume ExitHandler
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Proposed as answer by André Santo Friday, July 24, 2015 10:55 AM
    Friday, July 24, 2015 8:35 AM
  • Hi Hans,

    Many thanks for your response. I am getting error at line (shown below)

     If wrdRng.Find.Execute(FindText:="Good Person Score=[0-9]{1,}", MatchWildcards:=True) = False Then



    sammy

    Friday, July 24, 2015 10:58 AM
  • I have tested the code on a sample document and it worked...

    What is the text of the error message?


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, July 24, 2015 11:54 AM
  • Can you give this a try?

    Sub GetWordDocContents()
      Dim oWord As Object
      Dim vFiles
      Dim iFile As Integer
      Dim r As Range
      Dim LastRow As Long
       
      vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*", Title:="Please select the files you want to copy from", MultiSelect:=True)
      If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled
      Set oWord = CreateObject("Word.Application")
      oWord.Visible = True
      Set r = ActiveSheet.Range("A1")
      For iFile = LBound(vFiles) To UBound(vFiles)
        oWord.Documents.Open vFiles(iFile)
        oWord.ActiveDocument.Select
        oWord.Selection.Copy
        ActiveSheet.Paste r
       
        r.Offset(0, 6).Value = oWord.ActiveDocument.Name
        
        Set r = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
        oWord.ActiveDocument.Close False
    
      Next
      oWord.Quit
      Set oWord = Nothing
      ActiveSheet.Columns.AutoFit
    
        ' Delete row if blank
        Columns("A:A").Select
        For LastRow = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
           If Cells(LastRow, 1) = "" Then Rows(LastRow).Delete
        Next LastRow
        
    End Sub
    


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    Friday, July 24, 2015 9:03 PM
  • Hi sammy,

    What’s the error message that you get? You may share a sample file on the OneDrive and we will test it.

    Base on my test with Hans’s code, it is working fine.

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, July 27, 2015 8:12 AM
  • Hi Starain,

    Thanks for writing.

    What I want is, every document is having unique number in its first page. Say ex: In first page of word document, there we have "Application id=1234" & "Applciation id=55456" for other document in other folder and so on. Each word document will be having only one "Applciation id=454" I want to get that "Application id=****"(**** = different numbers in each first page of document in each folder). So, when I try using my code, it could not fetch "Application id=****" but instead, it is getting file name. See below image.
    Expected result:

    Current result which I got:

    I would provide my code in OneDrive. Please find it.

    http://1drv.ms/1GU3Z2H


    sammy

    Monday, July 27, 2015 12:17 PM
  • Hi sammy,

    Base on your code, you just to find the text in the word document and set the range data when the file name like FileToOpenVdocx.

    I suggest that you should to check the code logical and modify it to meet your requirement.

    On the other hand, you may share a sample file on the OneDrive.

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Tuesday, July 28, 2015 6:49 AM
  • Hi Starain,

    I got the whole word document data into a variable. But I need "Application ID:****" from the document. Instead, I got whole document data into a variable. I am confused, how to select only "Application ID:****" from documents (**** is a number which changes in each document it loops through). Here is my code & I am getting whole page data into a cell.

    Hans answers above to use 

    If wrdRng.Find.Execute(FindText:="Good Person Score=[0-9]{1,}", MatchWildcards:=True) = False Then

    I used it to filter my need. But I didn't achieve it. Can you please help me. The below is the updated my code.

                                                              

    Option Explicit

    Dim FSO As Object
    Dim strFolderName As String

    Dim FileToOpenVdocx As String
    Dim FileToOpenvdoc1 As String
    Dim FileToOpenVdoc As String
    Dim FileToOpenvdocx1 As String

    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim fsoFolder As Object

    'To copy data from word to excel

           'Copy data from word to excel


    Sub FindFilesInSubFolders()
        Dim fsoFolder As Scripting.Folder
    Sheets("Sheet1").Cells.Clear

        FileToOpenVdocx = "*V2.1.docx*"
        FileToOpenvdoc1 = "*v2.1.doc*"
        FileToOpenVdoc = "*V2.1.doc*"
        FileToOpenvdocx1 = "*v2.1.docx*"


        If FSO Is Nothing Then
           Set FSO = CreateObject("Scripting.FileSystemObject")
        End If

        'Set the parent folder for the new subfolders
        strFolderName = "C:\Test1"

        Set fsoFolder = FSO.GetFolder(strFolderName)
        Set wrdApp = CreateObject("Word.Application")

        OpenFilesInSubFolders fsoFolder
        wrdApp.Quit
     End Sub

    Sub OpenFilesInSubFolders(fsoPFolder As Scripting.Folder)
        Dim fsoSFolder As Scripting.Folder
        Dim fileDoc As Scripting.File
        Dim wrdRng As Object
        Dim strText As String

        Dim outRow As Long ' newly added
        outRow = 1 'you appear to want to start at the second row

        For Each fsoSFolder In fsoPFolder.SubFolders
        For Each fileDoc In fsoSFolder.Files

                If (fileDoc.Name Like FileToOpenVdocx Or fileDoc.Name Like FileToOpenvdoc1 Or fileDoc.Name Like FileToOpenVdoc Or fileDoc.Name Like FileToOpenvdocx1) And Left(fileDoc.Name, 1) <> "~" Then
                Set wrdDoc = wrdApp.Documents.Open(fileDoc.Path)
                Set wrdRng = wrdDoc.Content

                    If wrdRng.Find.Execute(FindText:="Application ID:[0-9]{1,}", MatchWildcards:=True) = True Then ' I AM NOT GETTING WHAT I AM WANTING EVEN THOUGH I WROTE THIS LINE.
                    MsgBox "Text not found!", vbExclamation
                    End If
              strText = wrdRng.Text
              'Range("B2").Value = strText

              'Cells(outRow & "B").Value = strText 'newly added
              Range("B" & outRow).Value = strText
               With wrdApp
                   .ActiveDocument.Tables(1).Select
                   .Selection.Copy
                   ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "D").End(xlUp)(1).PasteSpecial xlPasteValues
               End With
               wrdDoc.Close False
               'wrdApp.Quit
            outRow = outRow + 1 'newly added
            End If

            Next fileDoc
           'Debug.Print fsoSFolder

           OpenFilesInSubFolders fsoSFolder
        Next fsoSFolder
    End Sub




    sammy

    Tuesday, July 28, 2015 7:58 AM
  • Hi Sammy,

      If wrdRng.Find.Execute(FindText:="Application ID:[0-9]{1,}", MatchWildcards:=True) = True Then ' I AM NOT GETTING WHAT I AM WANTING EVEN THOUGH I WROTE THIS LINE.
                     MsgBox "Text not found!", vbExclamation
                     End If
       strText = wrdRng.Text

    The value of strText is what you want (Application ID:XXX), you could debug the code and check its value.

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Wednesday, July 29, 2015 3:27 AM