Question

我想创建一个在电子邮件中带有参考号的宏，我可以突出显示该宏并将其替换为直接指向网页的链接。

当前代码会将新的超链接放置在电子邮件的开头，而不是所选区域（当前为wddoc.Range（0，0））。我将指出无法确定范围的那一行。

如果我使用“选择”。它表示该变量未由用户定义。

 Sub AddHyperlink()
 Dim olEmail As Outlook.MailItem
 Dim olInsp As Outlook.Inspector
 Dim wdDoc As Object
 Dim oLink As Object
 Dim oRng As Object
 Dim strLink As String
 Dim strLinkText As String
 Dim OutApp As Object
 Dim OutMail As Object
 Dim strText As String

On Error Resume Next

'Get Outlook if it's running

Set OutApp = GetObject(, "Outlook.Application")



'Outlook wasn't running, so cancel

If Err <> 0 Then

    MsgBox "Outlook is not running so nothing can be selected!"

    GoTo lbl_Exit

End If

On Error GoTo 0



Set OutMail = OutApp.ActiveExplorer.Selection.Item(1)

With OutMail

    Set olInsp = .GetInspector

    Set wdDoc = olInsp.WordEditor

    strText = wdDoc.Application.Selection.Range.Text

End With



strLink = "http://website.com/#" & strText & "" ' the link address

strLinkText = "" & strText & "" ' the link display text



On Error Resume Next

Set olEmail = ActiveInspector.CurrentItem

With olEmail

    .BodyFormat = olFormatHTML

    Set olInsp = .GetInspector

    Set wdDoc = olInsp.WordEditor

    Set oRng = wdDoc.Range(0, 0) '!!!Cannot find something that replaces range with current selection!!!!

    oRng.Collapse 0

    Set oLink = wdDoc.Hyperlinks.Add(Anchor:=oRng, _

                         Address:=strLink, _

                         SubAddress:="", _

                         ScreenTip:="", _

                         TextToDisplay:=strLinkText)

    Set oRng = oLink.Range

    oRng.Collapse 0

    .Display

End With

lbl_Exit:

Exit Sub

End Sub

Answer 1

使用ActiveInspector的Outlook vba，请尝试以下操作。

Option Explicit
Public Sub Example()
    Dim wdDoc As Word.Document
    Dim rngSel As Word.selection

    If Application.ActiveInspector.EditorType = olEditorWord Then
        Set wdDoc = Application.ActiveInspector.WordEditor ' use WordEditor
        Set rngSel = wdDoc.Windows(1).selection ' Current selection

        wdDoc.Hyperlinks.Add rngSel.Range, _
        Address:="U:\plot.log", TextToDisplay:="Here is the link"
    End If

    Set wdDoc = Nothing
End Sub

根据选择Outlook VBA设置范围

1 个答案: