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

似乎我不需要ClassType，因为我想使用FileName。

任何人都可以帮助以下（a）将光标定位在超链接上，这样我就可以在文档中的每个位置输入一个新行和OLEObject。（b）从文件名的.ext中找到要使用的图标

由于

Answer 1

您无法从文件扩展名中获取ClassType。您需要在某处存储各种扩展的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

如何将超链接转换为嵌入式OLE对象

2 个答案: