如何使用 VBA 和 .OnAction 在 Outlook 2007 中打开网页？

Question

我正在尝试创建一个上下文菜单，以便当我右键单击某人的姓名时，它将查询网页以带回他们的 rolodex 信息。它不保存在本地联系人中。我在网页上有。

我有这个我发现并一直在使用（更大的子的sn-p），

 ' Configure the button to call the
        ' DisplayItemMetadata routine when
        ' clicked. The Parameter property of the
        ' button is set to the value of the
        ' EntryID property for the selected
        ' item, if possible.
        With objButton
            .Caption = "&Look Up Name"
            .FaceId = 1000
            .Tag = "DisplayItemMetadata"
            If Not IsNull(Selection.Item(1)) Then
                On Error GoTo 0
                ' Just in case the item selected
                ' doesn't have a valid EntryID.
                .Parameter = Selection.Item(1).EntryID
                On Error GoTo ErrRoutine
            End If
            '.OnAction = _
             '   "Project1.ThisOutlookSession.DisplayItemMetadata"
              .OnAction = _
                   "NavigateToURL(""http://somewebsite"")"
        End With

它从不调用 NavigateToURL 子。它从不调用该函数，因此我永远无法访问以下代码。没有错误。断点和调试显示它只是结束了 With 和 Sub。我试过用，

Call NavigateToURL(""http://somewebsite"")
NavigateToURL "http://somewebsite"

都不行。我得到Expected Expression。

Public Sub NavigateToURL(ByVal argURL As String)
MsgBox ("hi")
  Const READYSTATE_COMPLETE As Integer = 4

  Dim objIE As Object

  Set objIE = CreateObject("InternetExplorer.Application")

  With objIE
    .Visible = False
    .Silent = True
    .Navigate argURL
    Do Until .ReadyState = READYSTATE_COMPLETE
      DoEvents
    Loop
  End With

  objIE.Quit
  Set objIE = Nothing

End Sub

如果有其他方法可以使用上下文菜单打开网页？工具提示？

编辑：对不起。我必须找到我得到它的地方。来自Microsoft。

Sub Application_ItemContextMenuDisplay( _
    ByVal CommandBar As Office.CommandBar, _
    ByVal Selection As Selection)

    Dim objButton As Office.CommandBarButton

    On Error GoTo ErrRoutine

    If Selection.Count = 1 Then
        ' Add a new button to the bottom of the CommandBar
        ' (which represents the item context menu.)
        Set objButton = CommandBar.Controls.Add( _
            msoControlButton)

        ' Configure the button to call the
        ' DisplayItemMetadata routine when
        ' clicked. The Parameter property of the
        ' button is set to the value of the
        ' EntryID property for the selected
        ' item, if possible.
        With objButton
            .Caption = "&Display metadata"
            .FaceId = 1000
            .Tag = "DisplayItemMetadata"
            If Not IsNull(Selection.Item(1)) Then
                On Error GoTo 0
                ' Just in case the item selected
                ' doesn't have a valid EntryID.
                .Parameter = Selection.Item(1).EntryID
                On Error GoTo ErrRoutine
            End If
            .OnAction = _
                "Project1.ThisOutlookSession.DisplayItemMetadata"
        End With
    End If

EndRoutine:
    Exit Sub

ErrRoutine:
    MsgBox Err.Number & " - " & Err.Description, _
        vbOKOnly Or vbCritical, _
        "Application_ItemContextMenuDisplay"
    GoTo EndRoutine
End Sub

Private Sub DisplayItemMetadata()

    Dim objNamespace As NameSpace
    Dim objItem As Object
    Dim strEntryID As String

    On Error GoTo ErrRoutine

    ' Retrieve the value of the Parameter property from the
    ' control that called this routine.
    strEntryID = _
        Application.ActiveExplorer.CommandBars.ActionControl.Parameter

    ' If there's no entry ID, we can't easily retrieve the item.
    If strEntryID = "" Then
        MsgBox "An entry ID could not be retrieved from " & _
            "the selected menu item."
    Else
        ' Fetch an item reference using the specified entry ID.
        Set objNamespace = Application.GetNamespace("MAPI")
        Set objItem = objNamespace.GetItemFromID(strEntryID)

        If objItem Is Nothing Then
            MsgBox "A reference for the Outlook item " & _
                "could not be retrieved."
        Else
            ' Display information about the item.
            MsgBox "Message Class: " & objItem.MessageClass & vbCrLf & _
                "Size:          " & objItem.Size
        End If
    End If

EndRoutine:
    Set objItem = Nothing
    Set objNamespace = Nothing
    Exit Sub

ErrRoutine:
    MsgBox Err.Number & " - " & Err.Description, _
        vbOKOnly Or vbCritical, _
        "DisplayItemMetadata"
    GoTo EndRoutine
End Sub

Answer 1

注意： 如果您提供创建上下文菜单的代码，我很乐意对此进行测试，但除非您提供，否则我无法提供更多帮助那个代码。

我在上面的 cmets 中想说的是，您为 OnAction 指定了一个可能无法识别的参数，因此，没有调用任何过程。

仅基于示例语法，我假设这需要过程名称的完全限定结构。在示例语法中，它具有：

.OnAction = "Project1.ThisOutlookSession.SomeProcedure"

但是您的代码省略了项目和会话范围。

那么像.OnAction = "Project1.ThisOutlookSession.NavigateToURL" 这样的东西可能会起作用。

在上面，我将省略 URL 作为参数，这需要您稍微修改过程NavigateToURL。由于 URL 永远不会更改，因此将其作为参数传递给过程 NavigateToURL 是愚蠢的。在NavigateToURL 过程中，只需将其声明为Const 字符串。

Public Sub NavigateToURL()
Const argURL as String = "http://somewebsite.com"   '## Modify as needed
MsgBox ("hi")
  Const READYSTATE_COMPLETE As Integer = 4

  Dim objIE As Object

  Set objIE = CreateObject("InternetExplorer.Application")

  With objIE
    .Visible = False
    .Silent = True
    .Navigate argURL
    Do Until .ReadyState = READYSTATE_COMPLETE
      DoEvents
    Loop
  End With

  objIE.Quit
  Set objIE = Nothing

End Sub