home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch14 / contacts / contacts.frm (.txt) next >
Encoding:
Visual Basic Form  |  1996-05-27  |  10.4 KB  |  328 lines

  1. VERSION 5.00
  2. Begin VB.Form Contacts 
  3.    Caption         =   "VBA DEMO: Outlook 98 Contacts "
  4.    ClientHeight    =   5325
  5.    ClientLeft      =   60
  6.    ClientTop       =   375
  7.    ClientWidth     =   7950
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   5325
  10.    ScaleWidth      =   7950
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.ListBox List2 
  13.       BeginProperty Font 
  14.          Name            =   "Verdana"
  15.          Size            =   9
  16.          Charset         =   0
  17.          Weight          =   400
  18.          Underline       =   0   'False
  19.          Italic          =   0   'False
  20.          Strikethrough   =   0   'False
  21.       EndProperty
  22.       Height          =   2370
  23.       Left            =   5055
  24.       Sorted          =   -1  'True
  25.       TabIndex        =   3
  26.       Top             =   435
  27.       Width           =   2775
  28.    End
  29.    Begin VB.ListBox List1 
  30.       BeginProperty Font 
  31.          Name            =   "Verdana"
  32.          Size            =   9
  33.          Charset         =   0
  34.          Weight          =   400
  35.          Underline       =   0   'False
  36.          Italic          =   0   'False
  37.          Strikethrough   =   0   'False
  38.       EndProperty
  39.       Height          =   2370
  40.       Left            =   2055
  41.       TabIndex        =   2
  42.       Top             =   420
  43.       Width           =   2775
  44.    End
  45.    Begin VB.CommandButton Command2 
  46.       Caption         =   "View Contacts"
  47.       Enabled         =   0   'False
  48.       BeginProperty Font 
  49.          Name            =   "Verdana"
  50.          Size            =   9
  51.          Charset         =   0
  52.          Weight          =   400
  53.          Underline       =   0   'False
  54.          Italic          =   0   'False
  55.          Strikethrough   =   0   'False
  56.       EndProperty
  57.       Height          =   495
  58.       Left            =   90
  59.       TabIndex        =   1
  60.       Top             =   1155
  61.       Width           =   1815
  62.    End
  63.    Begin VB.CommandButton Command1 
  64.       Caption         =   "Start Outlook"
  65.       BeginProperty Font 
  66.          Name            =   "Verdana"
  67.          Size            =   9
  68.          Charset         =   0
  69.          Weight          =   400
  70.          Underline       =   0   'False
  71.          Italic          =   0   'False
  72.          Strikethrough   =   0   'False
  73.       EndProperty
  74.       Height          =   495
  75.       Left            =   90
  76.       TabIndex        =   0
  77.       Top             =   435
  78.       Width           =   1815
  79.    End
  80.    Begin VB.Label Label5 
  81.       Alignment       =   2  'Center
  82.       Caption         =   "Contacts"
  83.       BeginProperty Font 
  84.          Name            =   "Verdana"
  85.          Size            =   9.75
  86.          Charset         =   0
  87.          Weight          =   700
  88.          Underline       =   0   'False
  89.          Italic          =   0   'False
  90.          Strikethrough   =   0   'False
  91.       EndProperty
  92.       Height          =   285
  93.       Left            =   5055
  94.       TabIndex        =   13
  95.       Top             =   90
  96.       Width           =   2760
  97.    End
  98.    Begin VB.Label Label1 
  99.       Alignment       =   2  'Center
  100.       Caption         =   "Companies"
  101.       BeginProperty Font 
  102.          Name            =   "Verdana"
  103.          Size            =   9.75
  104.          Charset         =   0
  105.          Weight          =   700
  106.          Underline       =   0   'False
  107.          Italic          =   0   'False
  108.          Strikethrough   =   0   'False
  109.       EndProperty
  110.       Height          =   285
  111.       Left            =   2055
  112.       TabIndex        =   12
  113.       Top             =   75
  114.       Width           =   2805
  115.    End
  116.    Begin VB.Label Label4 
  117.       Caption         =   "E-Mail"
  118.       BeginProperty Font 
  119.          Name            =   "Verdana"
  120.          Size            =   9
  121.          Charset         =   0
  122.          Weight          =   400
  123.          Underline       =   0   'False
  124.          Italic          =   0   'False
  125.          Strikethrough   =   0   'False
  126.       EndProperty
  127.       Height          =   255
  128.       Left            =   3990
  129.       TabIndex        =   11
  130.       Top             =   4905
  131.       Width           =   735
  132.    End
  133.    Begin VB.Label lblEMail 
  134.       BorderStyle     =   1  'Fixed Single
  135.       BeginProperty Font 
  136.          Name            =   "Verdana"
  137.          Size            =   9
  138.          Charset         =   0
  139.          Weight          =   400
  140.          Underline       =   0   'False
  141.          Italic          =   0   'False
  142.          Strikethrough   =   0   'False
  143.       EndProperty
  144.       Height          =   315
  145.       Left            =   4860
  146.       TabIndex        =   10
  147.       Top             =   4875
  148.       Width           =   2970
  149.    End
  150.    Begin VB.Label Label6 
  151.       Alignment       =   2  'Center
  152.       Caption         =   "Selected Contact Information"
  153.       BeginProperty Font 
  154.          Name            =   "Verdana"
  155.          Size            =   9.75
  156.          Charset         =   0
  157.          Weight          =   700
  158.          Underline       =   0   'False
  159.          Italic          =   0   'False
  160.          Strikethrough   =   0   'False
  161.       EndProperty
  162.       Height          =   285
  163.       Left            =   4230
  164.       TabIndex        =   9
  165.       Top             =   3075
  166.       Width           =   3615
  167.    End
  168.    Begin VB.Label lblFAX 
  169.       BorderStyle     =   1  'Fixed Single
  170.       BeginProperty Font 
  171.          Name            =   "Verdana"
  172.          Size            =   9
  173.          Charset         =   0
  174.          Weight          =   400
  175.          Underline       =   0   'False
  176.          Italic          =   0   'False
  177.          Strikethrough   =   0   'False
  178.       EndProperty
  179.       Height          =   315
  180.       Left            =   4860
  181.       TabIndex        =   8
  182.       Top             =   4410
  183.       Width           =   2970
  184.    End
  185.    Begin VB.Label lblPhone 
  186.       BorderStyle     =   1  'Fixed Single
  187.       BeginProperty Font 
  188.          Name            =   "Verdana"
  189.          Size            =   9
  190.          Charset         =   0
  191.          Weight          =   400
  192.          Underline       =   0   'False
  193.          Italic          =   0   'False
  194.          Strikethrough   =   0   'False
  195.       EndProperty
  196.       Height          =   315
  197.       Left            =   4860
  198.       TabIndex        =   7
  199.       Top             =   3945
  200.       Width           =   2970
  201.    End
  202.    Begin VB.Label Label3 
  203.       Caption         =   "Phone Number"
  204.       BeginProperty Font 
  205.          Name            =   "Verdana"
  206.          Size            =   9
  207.          Charset         =   0
  208.          Weight          =   400
  209.          Underline       =   0   'False
  210.          Italic          =   0   'False
  211.          Strikethrough   =   0   'False
  212.       EndProperty
  213.       Height          =   255
  214.       Left            =   3975
  215.       TabIndex        =   6
  216.       Top             =   3975
  217.       Width           =   975
  218.    End
  219.    Begin VB.Label Label2 
  220.       Caption         =   "FAX"
  221.       BeginProperty Font 
  222.          Name            =   "Verdana"
  223.          Size            =   9
  224.          Charset         =   0
  225.          Weight          =   400
  226.          Underline       =   0   'False
  227.          Italic          =   0   'False
  228.          Strikethrough   =   0   'False
  229.       EndProperty
  230.       Height          =   255
  231.       Left            =   3975
  232.       TabIndex        =   5
  233.       Top             =   4440
  234.       Width           =   735
  235.    End
  236.    Begin VB.Label lblName 
  237.       BorderStyle     =   1  'Fixed Single
  238.       BeginProperty Font 
  239.          Name            =   "Verdana"
  240.          Size            =   9
  241.          Charset         =   0
  242.          Weight          =   400
  243.          Underline       =   0   'False
  244.          Italic          =   0   'False
  245.          Strikethrough   =   0   'False
  246.       EndProperty
  247.       Height          =   315
  248.       Left            =   3960
  249.       TabIndex        =   4
  250.       Top             =   3495
  251.       Width           =   3870
  252.    End
  253. Attribute VB_Name = "Contacts"
  254. Attribute VB_GlobalNameSpace = False
  255. Attribute VB_Creatable = False
  256. Attribute VB_PredeclaredId = True
  257. Attribute VB_Exposed = False
  258. '  ******************************
  259. '  ******************************
  260. '  ** MASTERING VB6            **
  261. '  ** by Evangelos Petroutos   **
  262. '  ** SYBEX, 1998              **
  263. '  ******************************
  264. '  ******************************
  265. Dim OLApp As Application
  266. Dim mNameSpace As NameSpace
  267. Dim mContact As Object
  268. Dim allContacts As Object
  269. Private Sub Command1_Click()
  270. On Error GoTo OutlookNotStarted
  271.     Set OLApp = CreateObject("Outlook.Application")
  272. On Error GoTo NoMAPINameSpace
  273.     Set mNameSpace = OLApp.GetNamespace("MAPI")
  274.     List1.Clear
  275.     List2.Clear
  276.     Command2.Enabled = True
  277.     Exit Sub
  278. OutlookNotStarted:
  279.     MsgBox "Could not start Outlook"
  280.     Exit Sub
  281. NoMAPINameSpace:
  282.     MsgBox "Could not get MAPI NameSpace"
  283.     Exit Sub
  284. End Sub
  285. Private Sub Command2_Click()
  286.     Set allContacts = mNameSpace.GetDefaultFolder(olFolderContacts).Items
  287.     allContacts.Sort "CompanyName"
  288. On Error Resume Next
  289.     For Each mContact In allContacts
  290.         If Trim(mContact.CompanyName) <> "" Then List1.AddItem mContact.CompanyName
  291.         If List1.List(List1.NewIndex) = List1.List(List1.NewIndex - 1) Then List1.RemoveItem List1.NewIndex
  292.     Next
  293. End Sub
  294. Private Sub List1_Click()
  295. Dim CompanyName As String
  296. Dim filterString As String
  297.     If List1.ListIndex = -1 Then Exit Sub
  298.     CompanyName = List1.Text
  299.     filterString = "[CompanyName] = """ & CompanyName & """"
  300.         
  301.     Set thiscontact = allContacts.Find(filterString)
  302.     If IsNull(thiscontact) Then
  303.         MsgBox "Fatal error in locating a contact. Program will exit"
  304.         End
  305.     End If
  306.     List2.Clear
  307.     While Not thiscontact Is Nothing
  308.         If Trim(thiscontact.FullName) <> "" Then List2.AddItem thiscontact.FullName
  309.         Set thiscontact = allContacts.FindNext
  310.     Wend
  311. End Sub
  312. Private Sub List2_Click()
  313. Dim ContactName As String
  314. Dim filterString As String
  315.     If List2.ListIndex = -1 Then Exit Sub
  316.     ContactName = List2.Text
  317.     filterString = "[FullName] = """ & ContactName & """"
  318.     Set thiscontact = allContacts.Find(filterString)
  319.     If IsNull(thiscontact) Then
  320.         MsgBox "Fatal error in locating a contact's name. Program will exit"
  321.         End
  322.     End If
  323.     lblName.Caption = " " & thiscontact.FullName
  324.     lblPhone.Caption = " " & thiscontact.BusinessTelephoneNumber
  325.     lblFAX.Caption = " " & thiscontact.BusinessFaxNumber
  326.     lblEMail.Caption = " " & thiscontact.Email1Address
  327. End Sub
  328.