home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch14 / messages / messages.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-05-23  |  15.3 KB  |  478 lines
  1. VERSION 5.00
  2. Begin VB.Form MsgForm 
  3.    Caption         =   "Reading Incoming Messages"
  4.    ClientHeight    =   6405
  5.    ClientLeft      =   60
  6.    ClientTop       =   375
  7.    ClientWidth     =   10335
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   6405
  10.    ScaleWidth      =   10335
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton Command1 
  13.       Caption         =   "E X I T"
  14.       BeginProperty Font 
  15.          Name            =   "Verdana"
  16.          Size            =   9.75
  17.          Charset         =   0
  18.          Weight          =   400
  19.          Underline       =   0   'False
  20.          Italic          =   0   'False
  21.          Strikethrough   =   0   'False
  22.       EndProperty
  23.       Height          =   480
  24.       Left            =   8490
  25.       TabIndex        =   19
  26.       Top             =   5775
  27.       Width           =   1740
  28.    End
  29.    Begin VB.TextBox txtBody 
  30.       BackColor       =   &H00C0C0C0&
  31.       BeginProperty Font 
  32.          Name            =   "Verdana"
  33.          Size            =   8.25
  34.          Charset         =   0
  35.          Weight          =   400
  36.          Underline       =   0   'False
  37.          Italic          =   0   'False
  38.          Strikethrough   =   0   'False
  39.       EndProperty
  40.       Height          =   2115
  41.       Left            =   4350
  42.       Locked          =   -1  'True
  43.       MultiLine       =   -1  'True
  44.       ScrollBars      =   3  'Both
  45.       TabIndex        =   18
  46.       Top             =   3390
  47.       Width           =   5730
  48.    End
  49.    Begin VB.CommandButton Command4 
  50.       Caption         =   "Attachments"
  51.       BeginProperty Font 
  52.          Name            =   "Verdana"
  53.          Size            =   9
  54.          Charset         =   0
  55.          Weight          =   400
  56.          Underline       =   0   'False
  57.          Italic          =   0   'False
  58.          Strikethrough   =   0   'False
  59.       EndProperty
  60.       Height          =   495
  61.       Left            =   360
  62.       TabIndex        =   9
  63.       Top             =   4920
  64.       Width           =   1815
  65.    End
  66.    Begin VB.CommandButton Command3 
  67.       Caption         =   "Show Selected Messages"
  68.       BeginProperty Font 
  69.          Name            =   "Verdana"
  70.          Size            =   9
  71.          Charset         =   0
  72.          Weight          =   400
  73.          Underline       =   0   'False
  74.          Italic          =   0   'False
  75.          Strikethrough   =   0   'False
  76.       EndProperty
  77.       Height          =   495
  78.       Left            =   6960
  79.       TabIndex        =   7
  80.       Top             =   2040
  81.       Width           =   2895
  82.    End
  83.    Begin VB.ListBox List1 
  84.       BeginProperty Font 
  85.          Name            =   "Verdana"
  86.          Size            =   9
  87.          Charset         =   0
  88.          Weight          =   400
  89.          Underline       =   0   'False
  90.          Italic          =   0   'False
  91.          Strikethrough   =   0   'False
  92.       EndProperty
  93.       Height          =   2160
  94.       Left            =   105
  95.       TabIndex        =   6
  96.       Top             =   285
  97.       Width           =   5295
  98.    End
  99.    Begin VB.CheckBox chkCompany 
  100.       Caption         =   "From this sender"
  101.       BeginProperty Font 
  102.          Name            =   "Verdana"
  103.          Size            =   9
  104.          Charset         =   0
  105.          Weight          =   400
  106.          Underline       =   0   'False
  107.          Italic          =   0   'False
  108.          Strikethrough   =   0   'False
  109.       EndProperty
  110.       Height          =   255
  111.       Left            =   5880
  112.       TabIndex        =   5
  113.       Top             =   240
  114.       Width           =   2175
  115.    End
  116.    Begin VB.ComboBox Combo1 
  117.       BeginProperty Font 
  118.          Name            =   "Verdana"
  119.          Size            =   9
  120.          Charset         =   0
  121.          Weight          =   400
  122.          Underline       =   0   'False
  123.          Italic          =   0   'False
  124.          Strikethrough   =   0   'False
  125.       EndProperty
  126.       Height          =   330
  127.       Left            =   6720
  128.       Sorted          =   -1  'True
  129.       TabIndex        =   4
  130.       Top             =   600
  131.       Width           =   3135
  132.    End
  133.    Begin VB.TextBox DateTo 
  134.       BeginProperty Font 
  135.          Name            =   "Verdana"
  136.          Size            =   9
  137.          Charset         =   0
  138.          Weight          =   400
  139.          Underline       =   0   'False
  140.          Italic          =   0   'False
  141.          Strikethrough   =   0   'False
  142.       EndProperty
  143.       Height          =   285
  144.       Left            =   8760
  145.       TabIndex        =   3
  146.       Text            =   "12/31/98"
  147.       Top             =   1440
  148.       Width           =   1095
  149.    End
  150.    Begin VB.TextBox DateFrom 
  151.       BeginProperty Font 
  152.          Name            =   "Verdana"
  153.          Size            =   9
  154.          Charset         =   0
  155.          Weight          =   400
  156.          Underline       =   0   'False
  157.          Italic          =   0   'False
  158.          Strikethrough   =   0   'False
  159.       EndProperty
  160.       Height          =   285
  161.       Left            =   6720
  162.       TabIndex        =   1
  163.       Text            =   "1/1/97"
  164.       Top             =   1440
  165.       Width           =   1095
  166.    End
  167.    Begin VB.CheckBox chkDate 
  168.       Caption         =   "Between these dates"
  169.       BeginProperty Font 
  170.          Name            =   "Verdana"
  171.          Size            =   9
  172.          Charset         =   0
  173.          Weight          =   400
  174.          Underline       =   0   'False
  175.          Italic          =   0   'False
  176.          Strikethrough   =   0   'False
  177.       EndProperty
  178.       Height          =   255
  179.       Left            =   5880
  180.       TabIndex        =   0
  181.       Top             =   1080
  182.       Width           =   2415
  183.    End
  184.    Begin VB.Label Label8 
  185.       Caption         =   "Selected Messages"
  186.       BeginProperty Font 
  187.          Name            =   "Verdana"
  188.          Size            =   9.75
  189.          Charset         =   0
  190.          Weight          =   700
  191.          Underline       =   0   'False
  192.          Italic          =   0   'False
  193.          Strikethrough   =   0   'False
  194.       EndProperty
  195.       Height          =   375
  196.       Left            =   105
  197.       TabIndex        =   20
  198.       Top             =   0
  199.       Width           =   2985
  200.    End
  201.    Begin VB.Label lblSender 
  202.       BorderStyle     =   1  'Fixed Single
  203.       BeginProperty Font 
  204.          Name            =   "Verdana"
  205.          Size            =   9
  206.          Charset         =   0
  207.          Weight          =   400
  208.          Underline       =   0   'False
  209.          Italic          =   0   'False
  210.          Strikethrough   =   0   'False
  211.       EndProperty
  212.       Height          =   255
  213.       Left            =   1200
  214.       TabIndex        =   17
  215.       Top             =   3600
  216.       Width           =   2775
  217.    End
  218.    Begin VB.Label Label2 
  219.       Caption         =   "Date Sent"
  220.       BeginProperty Font 
  221.          Name            =   "Verdana"
  222.          Size            =   9
  223.          Charset         =   0
  224.          Weight          =   400
  225.          Underline       =   0   'False
  226.          Italic          =   0   'False
  227.          Strikethrough   =   0   'False
  228.       EndProperty
  229.       Height          =   255
  230.       Left            =   360
  231.       TabIndex        =   16
  232.       Top             =   3960
  233.       Width           =   1095
  234.    End
  235.    Begin VB.Label Label3 
  236.       Caption         =   "Sender"
  237.       BeginProperty Font 
  238.          Name            =   "Verdana"
  239.          Size            =   9
  240.          Charset         =   0
  241.          Weight          =   400
  242.          Underline       =   0   'False
  243.          Italic          =   0   'False
  244.          Strikethrough   =   0   'False
  245.       EndProperty
  246.       Height          =   255
  247.       Left            =   360
  248.       TabIndex        =   15
  249.       Top             =   3600
  250.       Width           =   735
  251.    End
  252.    Begin VB.Label lblSent 
  253.       BorderStyle     =   1  'Fixed Single
  254.       BeginProperty Font 
  255.          Name            =   "Verdana"
  256.          Size            =   9
  257.          Charset         =   0
  258.          Weight          =   400
  259.          Underline       =   0   'False
  260.          Italic          =   0   'False
  261.          Strikethrough   =   0   'False
  262.       EndProperty
  263.       Height          =   255
  264.       Left            =   2520
  265.       TabIndex        =   14
  266.       Top             =   3960
  267.       Width           =   1455
  268.    End
  269.    Begin VB.Label lblRecvd 
  270.       BorderStyle     =   1  'Fixed Single
  271.       BeginProperty Font 
  272.          Name            =   "Verdana"
  273.          Size            =   9
  274.          Charset         =   0
  275.          Weight          =   400
  276.          Underline       =   0   'False
  277.          Italic          =   0   'False
  278.          Strikethrough   =   0   'False
  279.       EndProperty
  280.       Height          =   255
  281.       Left            =   2520
  282.       TabIndex        =   13
  283.       Top             =   4320
  284.       Width           =   1455
  285.    End
  286.    Begin VB.Label Label6 
  287.       Alignment       =   2  'Center
  288.       Caption         =   "Selected Message Information"
  289.       BeginProperty Font 
  290.          Name            =   "Verdana"
  291.          Size            =   9.75
  292.          Charset         =   0
  293.          Weight          =   700
  294.          Underline       =   0   'False
  295.          Italic          =   0   'False
  296.          Strikethrough   =   0   'False
  297.       EndProperty
  298.       Height          =   375
  299.       Left            =   360
  300.       TabIndex        =   12
  301.       Top             =   3000
  302.       Width           =   3615
  303.    End
  304.    Begin VB.Label Label4 
  305.       Caption         =   "Date Received"
  306.       BeginProperty Font 
  307.          Name            =   "Verdana"
  308.          Size            =   9
  309.          Charset         =   0
  310.          Weight          =   400
  311.          Underline       =   0   'False
  312.          Italic          =   0   'False
  313.          Strikethrough   =   0   'False
  314.       EndProperty
  315.       Height          =   255
  316.       Left            =   360
  317.       TabIndex        =   11
  318.       Top             =   4320
  319.       Width           =   1575
  320.    End
  321.    Begin VB.Label Label5 
  322.       Caption         =   "Message Body"
  323.       BeginProperty Font 
  324.          Name            =   "Verdana"
  325.          Size            =   9.75
  326.          Charset         =   0
  327.          Weight          =   700
  328.          Underline       =   0   'False
  329.          Italic          =   0   'False
  330.          Strikethrough   =   0   'False
  331.       EndProperty
  332.       Height          =   255
  333.       Left            =   4320
  334.       TabIndex        =   10
  335.       Top             =   3000
  336.       Width           =   1695
  337.    End
  338.    Begin VB.Label Label7 
  339.       BorderStyle     =   1  'Fixed Single
  340.       Height          =   2895
  341.       Left            =   120
  342.       TabIndex        =   8
  343.       Top             =   2760
  344.       Width           =   10095
  345.    End
  346.    Begin VB.Label Label1 
  347.       Caption         =   "and"
  348.       BeginProperty Font 
  349.          Name            =   "Verdana"
  350.          Size            =   9
  351.          Charset         =   0
  352.          Weight          =   400
  353.          Underline       =   0   'False
  354.          Italic          =   0   'False
  355.          Strikethrough   =   0   'False
  356.       EndProperty
  357.       Height          =   255
  358.       Left            =   8040
  359.       TabIndex        =   2
  360.       Top             =   1455
  361.       Width           =   495
  362.    End
  363. Attribute VB_Name = "MsgForm"
  364. Attribute VB_GlobalNameSpace = False
  365. Attribute VB_Creatable = False
  366. Attribute VB_PredeclaredId = True
  367. Attribute VB_Exposed = False
  368. '  ******************************
  369. '  ******************************
  370. '  ** MASTERING VB6            **
  371. '  ** by Evangelos Petroutos   **
  372. '  ** SYBEX, 1998              **
  373. '  ******************************
  374. '  ******************************
  375. Dim OLApp As Application
  376. Dim mNameSpace As NameSpace
  377. Dim mFolder As MAPIFolder
  378. Dim mItem As MailItem
  379. Dim mMessage As Items
  380. Dim AllMessages As Items
  381. Dim SelectedMessages As New Collection
  382. Dim AllContacts As Items
  383. Dim MessageAttachments As Attachments
  384. Private Sub Command1_Click()
  385.     OLApp.Quit
  386.     Set OLApp = Nothing
  387.     End
  388. End Sub
  389. Private Sub Command3_Click()
  390. Dim CompanyName As String
  391. Dim filterString As String
  392. Dim thismessage As Object
  393. Dim msgContact As Object
  394. Dim SenderName As String
  395. ' Clear Collection of selected messages
  396.     For i = SelectedMessages.Count To 1 Step -1
  397.         SelectedMessages.Remove i
  398.     Next
  399. ' Valdate data
  400.     If Not (IsDate(DateFrom.Text) And IsDate(DateTo.Text)) Then
  401.         MsgBox "One of the dates you specified is invalid"
  402.         Exit Sub
  403.     End If
  404.     If chkCompany.Value And Combo1.ListIndex >= 0 Then
  405.         ContactName = Combo1.Text
  406.         filterString = "[SenderName] = """ & ContactName & """"
  407.     End If
  408.     If chkDate.Value Then
  409.         If filterString = "" Then
  410.             filterString = "[SentOn] > """ & DateFrom.Text & """ And [SentOn] < """ & DateTo.Text & """"
  411.         Else
  412.             filterString = filterString & " and [SentOn] > """ & DateFrom.Text & """ And [SentOn] < """ & DateTo.Text & """"
  413.         End If
  414.     End If
  415.     If filterString = "" Then
  416.         filterString = "[SentOn] > ""01/01/1980"""
  417.     End If
  418.     Set thismessage = AllMessages.Find(filterString)
  419.     If thismessage Is Nothing Then
  420.         MsgBox "No messages sent in the specified interval."
  421.     Else
  422.         List1.Clear
  423.         While Not thismessage Is Nothing
  424.             List1.AddItem thismessage.SenderName & Chr(9) & thismessage.Subject
  425.             SelectedMessages.Add thismessage
  426.             Set thismessage = AllMessages.FindNext
  427.         Wend
  428.         
  429.     End If
  430. End Sub
  431. Private Sub Command4_Click()
  432. Dim thisAttachment As Attachment
  433. Dim msg As String
  434.     msg = "The selected message contains the following attachments:"
  435.     For Each thisAttachment In MessageAttachments
  436.         msg = msg & vbCrLf & thisAttachment.PathName & "   (" & thisAttachment.Type & ")"
  437.     Next
  438.     MsgBox msg
  439. End Sub
  440. Private Sub Form_Load()
  441. On Error GoTo OutlookNotStarted
  442.     Set OLApp = CreateObject("Outlook.Application")
  443. On Error GoTo NoMAPINameSpace
  444.     Set mNameSpace = OLApp.GetNamespace("MAPI")
  445.     Set AllMessages = mNameSpace.GetDefaultFolder(olFolderInbox).Items
  446.     Set AllContacts = mNameSpace.GetDefaultFolder(olFolderContacts).Items
  447.     Combo1.Clear
  448.     For Each mcontact In AllContacts
  449.         Combo1.AddItem mcontact.FullName
  450.         If Combo1.List(Combo1.NewIndex) = Combo1.List(Combo1.NewIndex + 1) Then Combo1.RemoveItem Combo1.NewIndex
  451.     Next
  452.     Combo1.ListIndex = 0
  453.     Exit Sub
  454. OutlookNotStarted:
  455.     MsgBox "Could not start Outlook"
  456.     Exit Sub
  457. NoMAPINameSpace:
  458.     MsgBox "Could not get MAPI NameSpace"
  459.     Exit Sub
  460. End Sub
  461. Private Sub List1_Click()
  462. Dim thismessage As Object
  463. Dim MessageAttachments As Attachments
  464.     selectedEntry = List1.ListIndex + 1
  465.     If selectedEntry < 1 Then Exit Sub
  466.     Set thismessage = SelectedMessages.Item(selectedEntry)
  467.     lblSender.Caption = " " & thismessage.SenderName
  468.     lblSent.Caption = " " & thismessage.SentOn
  469.     lblRecvd.Caption = " " & thismessage.ReceivedTime
  470.     txtBody.Text = " " & thismessage.Body
  471.     Set MessageAttachments = thismessage.Attachments
  472.     If MessageAttachments.Count = 0 Then
  473.         Command4.Enabled = False
  474.     Else
  475.         Command4.Enabled = False
  476.     End If
  477. End Sub
  478.