0

我使用了一个应用程序(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 中找到要使用的图标

谢谢

4

2 回答 2

0

这是我的解决方案。特定于 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
于 2013-07-15T16:42:47.827 回答
0

您无法从文件扩展名中获取 ClassType。您需要在某处存储各种扩展的 ClassType 列表,并在代码中查找正确的 ClassType。

于 2013-07-14T00:20:30.107 回答