home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1997 November / DPPCPRO1197.ISO / code / OutlookContacts.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-08-29  |  3.6 KB  |  99 lines
  1. VERSION 5.00
  2. Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmOutlookContacts 
  3.    Caption         =   "Outlook Contacts"
  4.    ClientHeight    =   3390
  5.    ClientLeft      =   45
  6.    ClientTop       =   330
  7.    ClientWidth     =   5670
  8.    OleObjectBlob   =   "OutlookContacts.frx":0000
  9.    StartUpPosition =   1  'CenterOwner
  10. Attribute VB_Name = "frmOutlookContacts"
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = True
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. Dim appOutlook  As Outlook.Application
  16. Dim nmsOutlook  As NameSpace
  17. Dim fldContacts As MAPIFolder
  18. Private Sub cmdCancel_Click()
  19.     Me.Hide
  20. End Sub
  21. Private Sub cmdOK_Click()
  22.     Application.Selection.Text = txtAddress
  23.     Me.Hide
  24. End Sub
  25. Private Sub cmdSearch_Click()
  26.     Dim itmTemp As Object
  27.     Dim itmsSubset As Items
  28.     Me.MousePointer = fmMousePointerHourGlass
  29.     lstNames.Clear
  30.     txtAddress = ""
  31.     Set itmsSubset = fldContacts.Items.Restrict("[LastName] = """ & txtSearchFor & """" & _
  32.                                          " Or [FirstName] = """ & txtSearchFor & """" & _
  33.                                          " Or [CompanyName] = """ & txtSearchFor & """")
  34.     For Each itmTemp In itmsSubset
  35.         lstNames.AddItem itmTemp.FullName
  36.         lstNames.List(lstNames.ListCount - 1, 2) = itmTemp.FullName & vbCrLf & itmTemp.HomeAddress
  37.         lstNames.List(lstNames.ListCount - 1, 3) = itmTemp.FullName & vbCrLf & itmTemp.CompanyName & vbCrLf & itmTemp.BusinessAddress
  38.         lstNames.List(lstNames.ListCount - 1, 4) = itmTemp.FullName & vbCrLf & itmTemp.MailingAddress
  39.         lstNames.List(lstNames.ListCount - 1, 5) = itmTemp.FullName & vbCrLf & itmTemp.OtherAddress
  40.     Next itmTemp
  41.     If lstNames.ListCount > 0 Then
  42.         lstNames.ListIndex = 0
  43.         lstNames.SetFocus
  44.     Else
  45.         txtSearchFor.SetFocus
  46.     End If
  47.     Me.MousePointer = fmMousePointerDefault
  48. End Sub
  49. Private Sub lstNames_Click()
  50.     If optHome Then
  51.         txtAddress = lstNames.List(lstNames.ListIndex, 2)
  52.     ElseIf optBusiness Then
  53.         txtAddress = lstNames.List(lstNames.ListIndex, 3)
  54.     ElseIf optMailing Then
  55.         txtAddress = lstNames.List(lstNames.ListIndex, 4)
  56.     Else
  57.         txtAddress = lstNames.List(lstNames.ListIndex, 5)
  58.     End If
  59. End Sub
  60. Private Sub optBusiness_Click()
  61.     txtAddress = lstNames.List(lstNames.ListIndex, 3)
  62. End Sub
  63. Private Sub optHome_Click()
  64.     txtAddress = lstNames.List(lstNames.ListIndex, 2)
  65. End Sub
  66. Private Sub optMailing_Click()
  67.     txtAddress = lstNames.List(lstNames.ListIndex, 4)
  68. End Sub
  69. Private Sub optOther_Click()
  70.     txtAddress = lstNames.List(lstNames.ListIndex, 5)
  71. End Sub
  72. Private Sub txtSearchFor_Enter()
  73.     cmdSearch.Default = True
  74.     txtSearchFor.SelStart = 0
  75.     txtSearchFor.SelLength = Len(txtSearchFor)
  76. End Sub
  77. Private Sub txtSearchFor_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  78.     cmdOK.Default = True
  79. End Sub
  80. Private Sub UserForm_Activate()
  81.     txtSearchFor = Trim$(Application.Selection.Text)
  82.     If txtSearchFor <> "" Then
  83.         cmdSearch = True
  84.     End If
  85. End Sub
  86. Private Sub UserForm_Initialize()
  87.     Me.MousePointer = fmMousePointerHourGlass
  88.     Set appOutlook = CreateObject("Outlook.Application")
  89.     Set nmsOutlook = appOutlook.GetNamespace("MAPI")
  90.     Set fldContacts = nmsOutlook.GetDefaultFolder(olFolderContacts)
  91.             
  92.     Me.MousePointer = fmMousePointerDefault
  93. End Sub
  94. Private Sub UserForm_Terminate()
  95.     Set fldContacts = Nothing
  96.     Set nmsOutlook = Nothing
  97.     Set appOutlook = Nothing
  98. End Sub
  99.