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.