Küldök két word makrót. Remélem ilyesmire gondoltál. (Office 2007 alatt 
teszteltem, remélem nem lesz gond az újabb wordben sem.)
Az elsőt egy üres dokumentumból kell indítani. Bekéri a könyvtárat, 
amiből dolgozzon. Az abban levő .docx-eket megnyitva megkeresi a 
hyperlinkeket, majd azokat az üres dokumentumba másolja szövegként. A 
kapott eredmény formája:
http://valami1.cim
http://valahol.cim
http://valami.cim
.docx neve
http://masvalami.cim
másik .docx neve
stb.
Az alkönyvtárakat nem nézi meg, a sima szövegként levő címekkel nem 
foglalkozik, csak a hiperhivatkozásokkal.
A másodikat egy megnyitott doc-ból kell indítani. Az ebben a doc-ban 
levő hiperhivatkozásokat keresi meg, és rakja egy üres dokumentumba.
Sub web_hivatkozas_konyvtarbol()
     Dim oLink As Hyperlink
     Dim docCurrent As Document
     Dim doc_keres As Document
     Dim rngStory As StoryRanges
     Set docCurrent = ActiveDocument
Dim SrcFldr As String
MsgBox "Válaszd ki a forrás mappát!"
With Application.FileDialog(msoFileDialogFolderPicker)
     .AllowMultiSelect = False
     .Show
SrcFldr = .SelectedItems(1)
End With
Application.ScreenUpdating = False
  n$ = Dir(SrcFldr & "\" & "*.docx")
If n$ <> "" Then
On Error GoTo hiba
While n$ <> ""
Selection.InsertBefore Text:=(n$ + Chr(13))
Documents.Open SrcFldr & "\" & n$
  Windows(n$).Activate
  Set doc_keres = ActiveDocument
     For Each oLink In doc_keres.Hyperlinks
         Set rng = docCurrent.Range
         rng.Collapse
         rng.InsertAfter (oLink.Address) + Chr(13)
      Next
     doc_keres.Close (wdDoNotSaveChanges)
      docCurrent.Activate
n$ = Dir()
Wend
     Else
         Application.ScreenUpdating = True
         MsgBox ("A könyvtár nem tartalmaz .docx fájlt")
         Set doc_keres = Nothing
         Set docCurrent = Nothing
         Exit Sub
End If
Application.ScreenUpdating = True
     Set doc_keres = Nothing
     Set docCurrent = Nothing
     Exit Sub
hiba:
Application.ScreenUpdating = True
MsgBox ("Valami hiba történt!")
a = Err.Number
Stop
End Sub
Sub web_hivatkozas_docbol()
     Dim docCurrent As Document
     Dim docNew As Document
     Dim oLink As Hyperlink
     Dim rng As Range
     Application.ScreenUpdating = False
     Set docCurrent = ActiveDocument
     Set docNew = Documents.Add
     For Each oLink In docCurrent.Hyperlinks
         Set rng = docNew.Range
         rng.Collapse
'        rng.InsertAfter (oLink.TextToDisplay) + Chr(9) + 
(oLink.Address) + Chr(13)
         rng.InsertAfter (oLink.Address) + Chr(13)
     Next
     docNew.Activate
     Application.ScreenUpdating = True
     Application.ScreenRefresh
End Sub
 |