Click to dial Outlook RRS feed

  • Question

  • Hello,

    I need to create an application that allows to call a contact in the contact folder or in a mail like this .

    But I don't find any event or something that allows to recover a contact in a mail.

    I find this site  :

    but I don't know how add for the contact section and how recover contact information.

    Could you help me ?

    • Edited by Akator64 Wednesday, February 10, 2016 9:06 AM
    Wednesday, February 10, 2016 8:53 AM


  • Hi Akator64,

    We could base on Explorer or Inspector to get the object (e.g. contact), for example:

    Function GetCurrentItem() As Object
        Dim objApp As Outlook.Application
        Set objApp = Application
        On Error Resume Next
        Select Case TypeName(objApp.ActiveWindow)
            Case "Explorer"
                Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
            Case "Inspector"
                Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
        End Select
        Set objApp = Nothing
    End Function

    We also could base on some conditions to search objects, for example:

    Sub FindEmailAddressInContacts()
      Dim objApp As Application
      Dim objNS As NameSpace
      Dim objContacts As MAPIFolder
      Dim colItems As Items
      Dim objItem As Object
      Dim strAddress As String
      Dim strWhere As String
      Dim blnFound As Boolean
      ' get folder to search
      Set objApp = CreateObject("Outlook.Application")
      Set objNS = objApp.GetNamespace("MAPI")
      Set objContacts = objNS.GetDefaultFolder(olFolderContacts)
      strWhere = "[Email1Address] <> vbNullString " & _
                 "Or [Email2Address] <> vbNullString " & _
                 "Or [Email3Address] <> vbNullString "
      Set colItems = objContacts.Items.Restrict(strWhere)
      ' get address to search for
      strAddress = InputBox("Find an Address in Contacts")
      If strAddress <> "" Then
        colItems.SetColumns ("Email1Address, Email2Address, Email3Address")
        For Each objItem In colItems
          ' must test for item type to avoid distribution lists
          If TypeName(objItem) = "ContactItem" Then
            If InStr(objItem.Email1Address, strAddress) > 0 Then
              blnFound = True
              Exit For
            ElseIf InStr(objItem.Email2Address, strAddress) > 0 Then
              blnFound = True
              Exit For
            ElseIf InStr(objItem.Email3Address, strAddress) > 0 Then
              blnFound = True
              Exit For
            End If
          End If
      End If
      If Not blnFound Then
        MsgBox "Not Found"
      End If
      Set objItem = Nothing
      Set colItems = Nothing
      Set objContacts = Nothing
      Set objNS = Nothing
      Set objApp = Nothing
    End Sub



    Thursday, February 11, 2016 9:29 AM