Delete hyperlinked text-CodePudding

I have the following code, which selects all hyperlinks with the "servlet" word in it and creates objects from local disk that matches the name of hyperlink:

Sub Replace_Link()
Dim strPath As String
Dim sName As String
Dim oRng As Range
Dim H As Hyperlink
    strPath = ActiveDocument.Path & "\attachments\"
    For Each H In ActiveDocument.Hyperlinks
        If InStr(H.Address, "servlet") <> 0 Then
            Set oRng = H.Range
            sName = Dir$(strPath & Trim(oRng.Text) & ".*")
            If Not sName = "" Then
                oRng.InlineShapes.AddOLEObject ClassType:="htmlfile", FileName:= _
                strPath & sName, LinkToFile:=False, _
                DisplayAsIcon:=False
            Set oRng = Nothing
            End If
        End If
    Next H
End Sub

The thing is that the hyperlink is still present next to the object. I know how to delete the hyperlink, but how to delete its text also? E.g.: The image.png hyperlink needs to be gone at all

CodePudding user response：

Solved it myself:

Sub Replace_Link()
Dim strPath As String
Dim sName As String
Dim oRng As Range
Dim H As Hyperlink, iH As Long, iCount As Long
    strPath = ActiveDocument.Path & "\attachments\"
    For Each H In ActiveDocument.Hyperlinks
        If InStr(H.Address, "servlet") <> 0 Then
            Set oRng = H.Range
            sName = Dir$(strPath & Trim(oRng.Text) & ".*")
            If Not sName = "" Then
                oRng.InlineShapes.AddOLEObject ClassType:="htmlfile", FileName:= _
                strPath & sName, LinkToFile:=False, _
                DisplayAsIcon:=False
            Set oRng = Nothing
            End If
        End If
    Next H
    Let iH = ActiveDocument.Hyperlinks.Count
    For iCount = iH To 1 Step -1
        Set H = ActiveDocument.Hyperlinks(iCount)
        If InStr(H.Address, "servlet") Then
            Set oRng = H.Range
            oRng.Delete
        End If
    Next iCount
    Set H = Nothing
End Sub

CodePudding user response：

A better way to solve this is to perform all required operations in a single loop.

Sub Replace_Link()
    Dim strPath As String
    Dim sName As String
    Dim oRng As Range
    Dim H As Hyperlink, iCount As Long
    strPath = ActiveDocument.Path & "\attachments\"
    For iCount = ActiveDocument.Hyperlinks.Count To 1 Step -1
        Set H = ActiveDocument.Hyperlinks(iCount)
        If InStr(H.Address, "servlet") <> 0 Then
            Set oRng = H.Range
            sName = Dir$(strPath & Trim(oRng.Text) & ".*")
            If Not sName = "" Then
                oRng.InlineShapes.AddOLEObject ClassType:="htmlfile", FileName:= _
                    strPath & sName, LinkToFile:=False, _
                    DisplayAsIcon:=False
                oRng.Delete
                Set oRng = Nothing
            End If
        End If
    Next iCount
    Set H = Nothing
End Sub