Excel Macro to open Word Doc, run Word VBA macro

[chris1993]

Hi everyone,

I have a macro that works in word but would like it to work like this:

1) Individual opens excel sheet and runs macro to be created.
2) Macro prompts user to input folder path, and then "*" so that it searches an entire folder of documents
3) Macro then opens word documents within folder, runs the word macro that I have already created, saves the word doc, then closes and moves to the next word doc.

I have a working excel macro that searches through excel workbooks, highlights words from a predefined list, saves and closes the workbook, then moves to the next in the folder and repeats.

I also have a word version of this macro but it does not have the capability to be run externally, in that it cannot be run on multiple word documents in a folder.

My goal is to be able to click a button in excel with a macro assigned, the macro prompts user for a folder path and document ("*" works for all), then the macro opens those documents and runs a second macro (the word one I have created), then save the doc and move to the next.


Here is the excel macro I have:

Sub AmbiguityCheck()     
    Dim Path            As String
    Dim File            As String
    Dim FileName        As String
    Dim Wkb             As Workbook
    Dim WS              As Worksheet
     
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Path = Application.InputBox("Enter full path name") & "\"
    File = Application.InputBox("Enter file name")
    FileName = Dir(Path & File, vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each WS In Wkb.Worksheets
           
        
           Dim fnd, r As Range, i&, wrd
           
           
'CHANGE TERMS BELOW'
    word_list1 = Array("above", "below", "it", "such", "the previous", "them", "these", "they", "this", "those", "all", "any", "appropriate", "custom", "efficient", "every", "few", "frequent", "improved", "infrequent", "intuitive", "invalid", "many", "most", "normal", "orginary", "rare", "same", "some", "the complete", "the entire", "transparent", "typical", "usual", "standard", "valid", "accordingly", "almost", "approximately", "by and large", "commonly", "customarily", "efficiently", "frequently", "generally", "hardly ever", "in general", "seamless", "several", "infrequently", "intuitively", "just about", "more often than not", "more or less", "mostly", "nearly", "normally", "not quite", "often", "on the odd occasion", "ordinarily", "rarely", "roughly", "seamlessly", "seldom", "similarily", "sometime", "somewhat", "transparently", "typically", "usually", "the application", "the component", "the date", "the database", "derive", "the field", "determine", "edit", "the file", "the frame", "enable")
    word_list2 = Array("the information", "improve", "the message", "indicate", "the module", "the page", "manipulate", "match", "the rule", "maximize", "the screen", "may", "the status", "might", "minimize", "the system", "the table", "modify", "the value", "optimize", "the window", "perform", "adjust", "process", "produce", "provide", "alter", "amend", "calculate", "support", "update", "validate", "verify", "change", "compare", "compute", "convert", "create", "customize")
'CHANGE TERMS ABOVE'
    
    
    
            word_list = Split(Join(word_list1, Chr(1)) & Chr(1) & Join(word_list2, Chr(1)), Chr(1))


            Application.ScreenUpdating = False


            With CreateObject("VBScript.RegExp")
                 .Global = True: .IgnoreCase = True


        For Each wrd In word_list
            .Pattern = "\b" & wrd & "\b"
            
            
'CHANGE RANGE BELOW'
            For Each r In WS.Range("A1:G40").Cells
'CHANGE RANGE ABOVE'
            
            
            
                If .Test(r) Then
                    With .Execute(r)
                        For i = 0 To .Count - 1
                            With r.Characters(.Item(i).FirstIndex + 1, .Item(i).Length).Font
                                .Bold = True: .Color = vbRed
                            End With
                        Next
                    End With
                End If
            Next r


        Next wrd
        
    
End With
Application.ScreenUpdating = True
           
           
    
        Next WS
        ActiveWorkbook.Close SaveChanges:=True
       
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
     
End Sub

Here is the word macro that I have:

Sub ambiguitycheckword()    Dim oRng As Range
    Dim i As Long
    Dim word_list1 As Variant
    Dim word_list2 As Variant
    Dim word_list As Variant
     
    word_list1 = Array("above", "below", "it", "such", "the previous", "them", "these", "they", "this", "those", "all", "any", "appropriate", "custom", "efficient", "every", "few", "frequent", "improved", "infrequent", "intuitive", "invalid", "many", "most", "normal", "orginary", "rare", "same", "some", "the complete", "the entire", "transparent", "typical", "usual", "standard", "valid", "accordingly", "almost", "approximately", "by and large", "commonly", "customarily", "efficiently", "frequently", "generally", "hardly ever", "in general", "seamless", "several", "infrequently", "intuitively", "just about", "more often than not", "more or less", "mostly", "nearly", "normally", "not quite", "often", "on the odd occasion", "ordinarily", "rarely", "roughly", "seamlessly", "seldom", "similarily", "sometime", "somewhat", "transparently", "typically", "usually", "the application", "the component", "the date", "the database", "derive", "the field", "determine", "edit", "the file", "the frame", "enable")
    word_list2 = Array("the information", "improve", "the message", "indicate", "the module", "the page", "manipulate", "match", "the rule", "maximize", "the screen", "may", "the status", "might", "minimize", "the system", "the table", "modify", "the value", "optimize", "the window", "perform", "adjust", "process", "produce", "provide", "alter", "amend", "calculate", "support", "update", "validate", "verify", "change", "compare", "compute", "convert", "create", "customize")
    word_list = Split(Join(word_list1, Chr(1)) & Chr(1) & Join(word_list2, Chr(1)), Chr(1))
    Application.ScreenUpdating = False
    For i = 0 To UBound(word_list)
        Set oRng = ActiveDocument.Range
        With oRng.Find
            Do While .Execute(FindText:=word_list(i), MatchWholeWord:=True)
                oRng.Font.Bold = True
                oRng.Font.Color = wdColorRed
                oRng.Collapse 0
            Loop
        End With
    Next i
    Application.ScreenUpdating = True
End Sub

Thank you!!!