简体   繁体   中英

How do you open a webpage in Outlook 2007 with VBA and .OnAction?

I am trying to create a context menu so that when I right-click on someone's name it will query a webpage to bring back their rolodex information. It is not kept in the local contacts. I have it in a webpage.

I have this I found and have been using (snippet of larger sub),

 ' 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

It never calls the NavigateToURL sub. It never calls the function, so I can never get to the below code. No errors. Breakpoints and Debug show it simply ending the With and Sub. I have tried using,

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

Neither work. I get 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

If there is another way to open a webpage with a context menu? Tooltip?

EDIT: Sorry. I had to find where I got it. It is from 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

NOTE: If you provide the code that creates the context menu, I'll gladly test this out, but I'm not going to be able to help much further unless you provide that code.

What I am trying to say in comments above, is that you have specified an argument for OnAction that may not be recognized, and as such, no procedure is being called.

Based only on the example syntax , I assume that this needs a fully-qualified construct of the procedure name. In the example syntax, it has:

.OnAction = "Project1.ThisOutlookSession.SomeProcedure"

But your code omits the Project and Session scope.

Something like .OnAction = "Project1.ThisOutlookSession.NavigateToURL" might work, then.

In the above, I would omit the URL as an argument, which requires you modify the procedure NavigateToURL slightly. since the URL is not changing ever, it is silly to pass this as an argument to the procedure NavigateToURL . Within the NavigateToURL procedure, simply declare this as a Const string.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM