Hyperlinks ändern

Sub Hyperlink()
Dim sHyp As Hyperlink
Dim oldAddress As String
Dim newAddress As String
Dim i As Integer
i = 0
'Anpassen !!!
oldAddress = "..\..\STA\MSR\Loops\"
newAddress = "H:\AMI-G\PBA\PBA Schicht\_WE\STA\MSR\Loops\"
For Each sHyp In Sheets("Meßstellen").Hyperlinks
If InStr(1, sHyp.Address, oldAddress) Then
sHyp.Address = Mid(sHyp.Address, 1, InStr(1, sHyp.Address, oldAddress) - 1) & _
newAddress & Mid(sHyp.Address, InStr(1, sHyp.Address, oldAddress) + Len(oldAddress))
'Zähler
i = i + 1
End If
Next
MsgBox ("fertig " & i)
End Sub