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

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

我找到了这个，并且一直在使用它（一段较大的子代码）

它从不调用NavigateToURL子函数。它从不调用函数，因此我永远无法获得下面的代码。没有错误。断点和调试显示它只是以和Sub结束。我尝试使用

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

两者都不起作用。我得到了

期望的表达式

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

是否有其他方法可以使用关联菜单打开网页？工具提示

编辑：对不起。我必须找到我从哪里得到的。这是我的

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

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

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

.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

---

您注释掉的示例代码使用了不同的结构来命名

OnAction

过程：

Project1。ThisOutlookSession…

您可能缺少什么？由于网站似乎没有动态变化，您可能也希望

NavigateToURL

过程中的

Const

，而不是将其作为参数发送（我认为这可能很棘手，因为您必须对其进行字符串设置）。如何使用.onAction（或其他方法）打开网页？您注释掉的示例代码使用不同的构造来命名OnAction过程：Project1。ThisOutlookSession。。。也许你的密码不完整？@DavidZemens我第一次读到它。我保证。我将阅读更多关于.OnAction的内容，因为我不明白你想说什么。我不知道为什么它找不到Sub，但我把它放在MsFt的股票Sub中。它不起作用。只是通过代码。我改变了。可见为真，IE窗口突然打开一秒钟就消失了。如果IE突然打开一秒钟，那么它显然会找到sub并执行代码。我不熟悉

.Silent

参数，可以将其设置为

False

，并使

.Visible=True

？

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

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