Sub UpdateDocuments() 
    Application.ScreenUpdating = False 
    Dim strFolder As String, strFile As String, wdDoc As Document 
    Dim rng As Range 
    Dim docSourse As Document 
    strFolder = GetFolder 
    If strFolder = "" Then Exit Sub 
    strFile = Dir(strFolder & "\*.docx", vbNormal) 
    While strFile <> "" 
        Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) 
        With wdDoc 
             'Call your other macro or insert its code here
             'Highlight all misspelled words.
             'Copy all misspelled words to new document.
            Set docSource = ActiveDocument 
            For Each rng In docSource.SpellingErrors 
                rng.Font.Color = wdColorRed 
                rng.Font.Bold = True 
            Next 
            .Close SaveChanges:=True 
        End With 
        strFile = Dir() 
    Wend 
    Set wdDoc = 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