Sub fieldlinksupdate()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim Path As String
Dim Excel As Object
Dim Exceldummy As Object
Application.DisplayStatusBar = True
Path = ActiveDocument.Path
i = ActiveDocument.Fields.Count
k = 1
Count = 0
Set Exceldummy = CreateObject("Excel.Application")
Set Excel = GetObject(, "Excel.Application")
Excel.Application.DisplayAlerts = False
Excel.Application.Asktoupdatelinks = False
Do
Set f = ActiveDocument.Fields(k)
Application.StatusBar = "Aktuell in Schleifendurchlauf " & k & " von " & i
If Not f.OLEFormat Is Nothing Then
f.LinkFormat.AutoUpdate = False
On Error GoTo Eingabefehler
Excel.Application.DisplayAlerts = False
Excel.Application.Asktoupdatelinks = False
Excel.Application.Quit
Eingabefehler:
f.LinkFormat.SourceFullName = Path & "\" & f.LinkFormat.SourceName 'Überschreiben des Links --> Hier wird die "neue" Datei "heruntergeladen", was zu Verzögerungen führt
Count = Count + 1
End If
k = k + 1
Loop Until k = i + 1
MsgBox ("Es wurden " & Count & " Links aktualisiert. Der neue Pfad lautet: " & ActiveDocument.Path)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub