Как преобразовать гиперссылки в вложенные объекты OLE

Question

Я использую приложение (HP Quality Center), которое создает отчет Word .docx с вложениями в виде гиперссылок, где гиперссылки указывают на вложения на диске C:\ моего компьютера.

Ясно, что я не могу отправить отчет по электронной почте или перенести в другое место со ссылками.

Я хочу преобразовать эти гиперссылки во встроенные объекты.

Я мог бы использовать макрос для итерации гиперссылок и добавления объектов ole, но мне было бы интересно, будет ли игнорировать ClassType. Это могут быть файлы.xls, pdf, doc, docx или другие. Могу ли я найти ClassType, посмотрев на имя файла?

Кто-нибудь делал это раньше?

Спасибо Джон

Обновление - что у меня пока

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

Кажется, мне не нужен ClassType, потому что я хочу использовать FileName.

Может ли кто-нибудь помочь с выполнением следующих действий (a) Поместите курсор на гиперссылку, чтобы я мог ввести новую строку и объект OLEObject в каждом месте документа. (б) Найдите иконку для использования из.ext файла

Спасибо

Answer 1

Вы не можете получить ClassType из расширения файла. Вам нужно будет где-то хранить список ClassTypes для различных расширений и искать правильный ClassType в вашем коде.

Answer 2

Вот мое решение. Специально для HP Quality Center. И я пока проигнорирую значки.

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