How to convert Hyperlinks to Embeded OLE Objects

Question

I use an application (HP Quality Center) that generates a Word .docx report with Attachments as Hyperlinks, where the hyperlinks point to the attachments on my PC's C:\ drive.

Clearly, I cannot send the report by email or move somewhere else, with the links.

I want to convert these hyperlinks to embedded objects.

I could use a Macro to iterate the hyperlinks, and add ole objects, but wondering whether ignoring the ClassType will be ok. The files could be .xls, pdf, doc, docx or others. Can I find the ClassType from looking at the filename?

Anyone done this before?

Thanks John

Update - what I have so far

Sub ConvertHyperLinks()
Dim num As Integer, i
Dim strFileName As String
Dim lngIndex As Long
Dim strPath() As String

num = ActiveDocument.Hyperlinks.Count
For i = 1 To num
    hName = ActiveDocument.Hyperlinks(i).Name
    strPath() = Split(hName, "\")
    lngIndex = UBound(strPath)
    strFileName = strPath(lngIndex)
    Selection.InlineShapes.AddOLEObject _
        FileName:=hName, _
        LinkToFile:=False, DisplayAsIcon:=True, _
        IconLabel:=strFileName
    ActiveDocument.Hyperlinks(i).Delete
Next
End Sub

Seems I don't need ClassType because I want to use FileName.

Can anyone help with following (a) Position the cursor at the hyperlink, so I can enter a new line and the OLEObject at each place within the document. (b) Find the Icon to use from the .ext of the filename

Thanks

It appears to. When I posted question, I had a syntax error which I thought was because I was leaving this blank — jradxl, Jul 15 '13 at 10:02

score 0 · Answer 1 · answered Jul 14 '13 at 00:20

0

You cannot obtain a ClassType from a file extension. You'll need to store a list of the ClassTypes for the various extensions somewhere, and look up the correct ClassType in your code.

answered Jul 14 '13 at 00:20

Andy G

19,232
5
47
69

score 0 · Answer 2 · answered Jul 15 '13 at 16:42

Here's my solution. Specific to HP Quality Center. And I'll ignore the Icons for now.

Sub ConvertHyperLinks()

'
' Macro to replace HyperLinks with embedded objects for
' report documents generated by HP Quality Center.
'

Dim numH, numT, i, j, k, m, n, rowCount, cellCount As Integer
Dim strPath() As String
Dim strFileName, strFileName2, strExt As String
Dim hName, tblCell1, reqidLabel, regId, preFixLen, preFix As String
Dim found As Boolean
Dim lngIndex As Long

numH = ActiveDocument.Hyperlinks.Count

For i = 1 To numH
    found = False
    hName = ActiveDocument.Hyperlinks(i).Name
    strPath() = Split(hName, "\")
    lngIndex = UBound(strPath)
    strFileName = strPath(lngIndex)
    strPath() = Split(strFileName, ".")
    lngIndex = UBound(strPath)
    strExt = UCase(strPath(lngIndex))

    strFileName2 = OnlyAlphaNumericChars(strFileName)

    'Each HyperLink is in single row/column table
    'And a FIELDLABEL table contains the REQ number
    'Iterate to find the current REQ number as it has been
    'prepended to the filename.
    'We are processess from start of doc to end
    'so the REQ number applies to the immediate Attachments
    'in the same document section.

    numT = ActiveDocument.Tables.Count
    For j = 1 To numT

      tblCell1 = OnlyAlphaNumericChars(ActiveDocument.Tables(j).Rows(1).Cells(1).Range.Text)

      If UCase(tblCell1) = "FIELDLABEL" Then
        rowCount = (ActiveDocument.Tables(j).Rows.Count)
        For k = 1 To rowCount
            cellCount = (ActiveDocument.Tables(j).Rows(k).Cells.Count)
            For m = 1 To cellCount
                reqidLabel = OnlyAlphaNumericChars(ActiveDocument.Tables(j).Rows(k).Cells(m).Range.Text)
                If reqidLabel = "ReqID" Then
                  regId = OnlyAlphaNumericChars(ActiveDocument.Tables(j).Rows(k).Cells(m + 1).Range.Text)
                  regId = "REQ" & regId
                  preFixLen = Len(regId)
                  preFix = Mid(strFileName2, 1, preFixLen)
                  If preFix = regId Then
                    found = True
                    Exit For
                  End If
                End If
            Next
            If found Then Exit For
        Next
      End If

      If found Then

         'Continue to iterate tables to find the actual table
         'containing the Link
         If UCase(regId & tblCell1) = UCase(strFileName2) Then
           'Select the table and move to the next document line
           'that follows it.
           ActiveDocument.Tables(j).Select
           Selection.Collapse WdCollapseDirection.wdCollapseEnd
           Selection.TypeText Text:=Chr(11)

           'Outstanding is finding an Icon for the type
           'of Object being embedded
           'This embeds with a blank Icon.
           'But the Icon caption is the Extension.

           Selection.InlineShapes.AddOLEObject _
               FileName:=hName, _
               LinkToFile:=False, DisplayAsIcon:=True, _
               IconLabel:=strExt
               'IconFileName:=strFileName, IconIndex:=0,

           Selection.TypeText Text:=Chr(11)
           Selection.TypeText Text:=strFileName
           Selection.TypeText Text:=Chr(11)
           Selection.TypeText Text:=Chr(11)
           Exit For
         End If
      End If
    Next
Next

'Delete all the Hyperlinks as they are meainingless
'if the document is to be emailed.
'TODO May delete the table the link is contained in.
With ActiveDocument
    For n = .Hyperlinks.Count To 1 Step -1
        .Hyperlinks(n).Delete
    Next
End With
End Sub

How to convert Hyperlinks to Embeded OLE Objects

2 Answers2