Найти в тексте ссылки, vbs

Set word = CreateObject("Word.Application")
Set document = word.Documents.Open("C:\path\to\СНИП 6768.docx")
For Each hl In document.HyperLinks
    Dim text, href
    text = hl.TextToDisplay
    href = hl.Address
    ' Здесь обрабатываем гиперссылки
 
Next
 
document.close()
word.Quit()

Doc = "C:\path\to\СНИП 6768.docx"
 
Set word = CreateObject("Word.Application")
word.Visible = False
Set Docx = word.Documents.Open(Doc, False, True)
For Each hl In Docx.HyperLinks
    S = S & vbLf & vbLf & hl.TextToDisplay & ": " & hl.Address
Next
Docx.close
word.Quit
 
With CreateObject("Scripting.FileSystemObject")
    If S <> "" Then .CreateTextFile(.GetparentFolderName(Doc) & "\Links.txt", 1, 1).Write Mid(S, 3)
End With

Path = "C:\Path\to\docs"
 
Set Word = CreateObject("Word.Application")
Set ShAp = CreateObject("Shell.Application")
Word.Visible = False
Set Items = ShAp.NameSpace(Path).Items
Items.Filter 8256, "*.docx"
For Each I In Items
    If Left(I.Name, 2) <> "~$" Then
        Set Docx = word.Documents.Open(I.Path, False, True)
        For Each hl In Docx.HyperLinks
            S = S & VbCrLf & VbCrLf & hl.TextToDisplay & ": " & hl.Address
        Next
        Docx.Close
    End If
Next : Word.Quit
With CreateObject("Scripting.FileSystemObject")
    List = .BuildPath(Path, "Links.txt")
    If S <> "" Then .CreateTextFile(List, 1, 1).Write Mid(S, 3)
End With : ShAp.Open List