Sub UpdateDocuments()
Dim strInFolder As String, strOutFold As String, strFile As String
Dim wdDoc As Document
Dim hLink As Hyperlink
Dim sAddress As String, sDisplay As String, sTip As String

    Application.ScreenUpdating = False
    strInFolder = GetFolder
    If strInFolder = "" Then Exit Sub
    strFile = Dir(strInFolder & "\*.doc*", vbNormal)

    'Check for documents in the folder - exit if none found
    If strFile <> "" Then strOutFold = strInFolder & "\Output\"

    'Test for an existing outpfolder & create one if it doesn't already exist
    If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
    strFile = Dir(strInFolder & "\*.doc*", vbNormal)
    While strFile <> ""
        Set wdDoc = Documents.Open(FileName:=strInFolder & "\" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)

        For Each hLink In wdDoc.Hyperlinks
            With hLink
                sAddress = .Address
                If InStr(1, LCase(sAddress), "www.yahoo.com") > 0 Then
                    .Target = Replace(LCase(.Target), "www.yahoo.com", "www.google.com")
                    .Address = Replace(LCase(.Address), "www.yahoo.com", "www.google.com")
                    .TextToDisplay = Replace(LCase(.TextToDisplay), "www.yahoo.com", "www.google.com")
                    .ScreenTip = "Click to search"
                End If
            End With
        Next hLink
    Next hLink

    'Save and close the document
    wdDoc.SaveAs FileName:=strOutFold & wdDoc.Name, AddToRecentFiles:=False
    wdDoc.Close
    strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub