Navigation

   Hej, 
jeg fandt en stykke VBA til at finde og erstatte dele af hyperlinks.
Virker super godt, men når url'en er for lang får jeg en "Out of memory" error.

Har prøvet at indsætte diverse kodestumper anbefalet ved Out Of memory fejlen.
Desværre hjalp det ikke.

Jeg har en ide om at det er fordi jeg bruger en MsgBox som ikke kan vise den lange url, men hvis jeg udkommenterer den del så får jeg ikke bekræftet at url skal skiftes.

Vil egentlig gerne at brugeren kan se hvad det gamle link er og hvad det nye er, og har tænkt at bruge en Userform i stedet - men mine VBA kompetencer er ikke god nok :D

Er der en her der kan "omksrive" koden til enten bare at rette fra gammel til ny ur - eller indsætte en Userform? 

Koden er denne

Sub changeLinks()

  Const oldPrefix = "http://projects.xxx.dk/"
  Const newPrefix = "https://projekt.xxx.dk/"
  Dim h As Hyperlink, oldLink As String, newLink As String

  For Each h In ActiveSheet.Hyperlinks
       'this will change Address but not TextToDisplay
       oldLink = h.Address
      Debug.Print "Found link: " & oldLink
      If Left(oldLink, Len(oldPrefix)) = oldPrefix Then
              newLink = newPrefix & Right(h.Address, Len(h.Address) - Len(oldPrefix))

              If MsgBox("Click OK to change:" & vbLf & vbLf & oldLink & _
                 vbLf & vbLf & "to" & vbLf & vbLf & newLink, vbOKCancel, _
                 "Confirmation?") <> vbOK Then Exit Sub

              h.Address = newLink
              Debug.Print "  Changed to " & h.Address
      End If
  Next h

 End Sub

Navigation

Out of memory - find og erstat dele af hyperlinks