Consulting

Results 1 to 2 of 2

Thread: Extract Certain Text from Word into Excel Using VBA

  1. #1

    Extract Certain Text from Word into Excel Using VBA

    Hi,
    i'm new to VBA and i'm learning now.
    My requirement is to match the word PROC or PRIC from a word document and move the next strings to excel under corresponding headers.
    for (e.g) my word document (sample.docx) contains
    PROC-1801
    PROC-1901
    PRIC-1801
    PRIC-1901


    my excel (sample1.xlsm) contains the heading
    PROC PRIC


    code need to check the word PROC and move the text 1801, 1901 to excel under the heading PROC like below
    PROC
    1801
    1901


    Have gone through some of the online site and come up with the below code. this code doesn't give any error but the results were not coming in sample1 spreadsheet.


    Code is given below:


    Sub GrabUsage()
    Dim FName As String, FD As FileDialog
    Dim WApp As Object, WDoc As Object, WDR As Object
    Dim ExR As Range


    Set ExR = Selection
    ' current location in Excel Sheet


    'Declare a string variable to access our Word document
    Dim strDocName As String
    'Error handling
    On Error Resume Next
    'Activate Word it is already open
    Set WApp = GetObject(, “Word.Application”)
    If Err.Number = 429 Then
    Err.Clear
    'Create a Word application if Word is not already open
    Set WApp = CreateObject(“Word.Application”)
    End If
    WApp.Visible = True
    strDocName = "C:\vb\sample.docx"
    'Check relevant directory for relevant document
    'If not found then inform the user and close program
    If Dir(strDocName) = “” Then
    MsgBox "The file " & strDocName & vbCrLf & "was not found in the folder path" & vbCrLf & "C:\vb\.", vbExclamation, "Sorry, that document name does not exist."
    Exit Sub
    End If


    WApp.Activate


    Set WDoc = WApp.Documents(strDocName)


    If WDoc Is Nothing Then Set WDoc = WApp.Documents.Open(strDocName)
    WDoc.Activate




    ' go home and search
    WApp.Selection.HomeKey Unit:=6
    WApp.Selection.Find.ClearFormatting
    WApp.Selection.Find.Execute "PROC"


    ' move cursor from find to final data item
    ' WApp.Selection.MoveDown Unit:=5, Count:=1
    WApp.Selection.MoveRight Unit:=2, Count:=1
    'the miracle happens here
    WApp.Selection.MoveRight Unit:=2, Count:=1, Extend:=1


    ' grab and put into excel
    Set WDR = WApp.Selection
    Dim rownum As Integer
    Dim columnum As Integer
    Dim Tble As Integer
    columnum = 1
    rownum = 1
    With WDoc
    'Tble = WDoc.ActiveDocument.Words.Count
    Tble = 5


    If Tble = 0 Then


    MsgBox "PROC not found in the Word document", vbExclamation, "No PROC found"
    Exit Sub
    End If
    'start the looping process to access tables and their rows, columns
    For i = 1 To Tble
    ExR(rownum, columnum) = WDR
    'insert in next row
    rownum = rownum + 1
    Next




    ' repeat
    WApp.Selection.HomeKey Unit:=6
    WApp.Selection.Find.ClearFormatting
    WApp.Selection.Find.Execute "PRIO"
    WApp.Selection.MoveRight Unit:=2, Count:=2
    WApp.Selection.MoveRight Unit:=2, Count:=2, Extend:=1


    Set WDR = WApp.Selection
    Dim rownum1 As Integer
    Dim columnum1 As Integer
    Dim Tble1 As Integer
    columnum1 = 2
    rownum1 = 1




    'Tble1 = WDoc.ActiveDocument.Words.Count
    Tble1 = 2
    If Tble1 = 0 Then


    MsgBox "PRIO not found in the Word document", vbExclamation, "No PRIO found"
    Exit Sub
    End If
    'start the looping process to access tables and their rows, columns
    For j = 1 To Tble1
    ExR(rownum1, columnum1) = WDR
    'insert in next row
    rownum1 = rownum1 + 1
    Next


    End With




    MsgBox "program was successful", vbExclamation, "successful"




    WDoc.Close
    WApp.Quit


    End Sub

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Cross-posted (and answered) at: https://www.excelforum.com/excel-pro...using-vba.html
    Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3
    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
  •