Extract Text in braquet and list of terms from 2 Docs

Discussion in 'Word' started by XRope, Jul 1, 2018.

  1. XRope

    XRope

    Joined:
    Jul 1, 2018
    Messages:
    2
    Likes Received:
    0
    Hi everyone,

    I Have a macro to extract text within parentheses from 2 Docs and put them in 2 columns in a new Doc.
    My problem is thta I want to add to that a list of countries but to extracted too from both Docs and added to the text in 2 columns, this of course in order of apearance.

    I have a list of countries but dont know where to put them in the code.

    Here is the code

    Sub GetTermsFrom2Docs_AddToNewDoc()

    Dim doc_name1 As String: doc_name1 = "C:\User\Desktop\test\Doc1.docx"
    Dim doc1 As Document: Set doc1 = Documents.Open(doc_name1)
    Dim rng1 As Range: Set rng1 = doc1.Content
    Dim arr1(1 To 1000)

    Dim doc_name2 As String: doc_name2 = "C:\User\Desktop\test\Doc2.docx"
    Dim doc2 As Document: Set doc2 = Documents.Open(doc_name2)
    Dim rng2 As Range: Set rng2 = doc2.Content
    Dim arr2(1 To 1000)

    Dim new_doc_name As String: new_doc_name = "C:\User\Desktop\test\NewDoc.docx"
    Dim new_doc As Document: Set new_doc = Documents.Add
    Dim new_doc_rng As Range: Set new_doc_rng = new_doc.Content
    new_doc.SaveAs2 new_doc_name

    Dim x As Integer
    x = 1
    With rng1.Find
    .ClearFormatting
    .Forward = True
    .Text = "\(*\)"
    .MatchWildcards = True
    .Execute
    Do While .Found
    arr1(x) = Mid(rng1.Text, 2, Len(rng1.Text) - 2)
    x = x + 1
    .Execute
    Loop
    End With
    doc1.Close

    x = 1
    With rng2.Find
    .ClearFormatting
    .Forward = True
    .Text = "\(*\)"
    .MatchWildcards = True
    .Execute
    Do While .Found
    arr2(x) = Mid(rng2.Text, 2, Len(rng2.Text) - 2)
    x = x + 1
    .Execute
    Loop
    End With
    doc2.Close

    Dim tbl As Table
    Set tbl = new_doc_rng.Tables.Add(new_doc_rng, 2, 2)

    tbl.Cell(1, 1).Range.Text = "Countries from Doc1:"
    tbl.Cell(1, 2).Range.Text = "Countries from Doc2:"

    Dim countries1_as_string As String
    For x = 1 To UBound(arr1)
    If arr1(x) <> "" Then
    countries1_as_string = _
    countries1_as_string & arr1(x) & Chr(10)
    End If
    Next x
    tbl.Cell(2, 1).Range.Text = countries1_as_string

    Dim countries2_as_string As String
    For x = 1 To UBound(arr1)
    If arr1(x) <> "" Then
    countries2_as_string = _
    countries2_as_string & arr2(x) & Chr(10)
    End If
    Next x
    tbl.Cell(2, 2).Range.Text = countries2_as_string

    new_doc.SaveAs2 new_doc_name
    End Sub
     
    XRope, Jul 1, 2018
    #1
    1. Advertisements

  2. XRope

    macropod Microsoft MVP

    Joined:
    Mar 2, 2012
    Messages:
    364
    Likes Received:
    32
    macropod, Jul 2, 2018
    #2
    1. Advertisements

  3. XRope

    XRope

    Joined:
    Jul 1, 2018
    Messages:
    2
    Likes Received:
    0
    All understood

    How do I delete this thread ?
     
    XRope, Jul 2, 2018
    #3
  4. XRope

    Becky Administrator

    Joined:
    Aug 3, 2011
    Messages:
    60
    Likes Received:
    5
    No need to delete the thread, but it would be useful if you could share any solution so that others can benefit :)
     
    Becky, Jul 2, 2018
    #4
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.