如何將超鏈接轉換爲嵌入式OLE對象

Question

我使用應用程序（HP Quality Center）生成帶附件的Word .docx報告作爲超鏈接，其超鏈接指向我的PC的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 

好像我不需要類類別，因爲我想使用的文件名。

任何人都可以幫忙以下 （a）將光標放在超鏈接上，這樣我就可以在文檔中的每個位置輸入一個新行和OLEObject。 （二）查找從文件名的.EXT使用

感謝

Answer 1

你不能從一個文件擴展名的類類別的圖標。您需要在各處存儲各種擴展的ClassType列表，並在您的代碼中查找正確的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