Question

我正在尝试创建一个上下文菜单，这样当我右键单击某人的名字时，它将查询一个网页以恢复他们的rolodex信息。它不会保留在本地联系人中。我把它放在网页上。

我找到了这个并且一直在使用（更大的子片段），

 ' 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

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

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

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

.OnAction = "Project1.ThisOutlookSession.SomeProcedure"

但是您的代码省略了Project和Session范围。

.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

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

1 个答案: