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

Question

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

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

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

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

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

Благодаря Джон

Update - то, что я до сих пор

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. И теперь я игнорирую значки.

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