VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx" Begin VB.Form frmSendEmail BackColor = &H00D1ADAD& BorderStyle = 3 'Fixed Dialog Caption = "title here..." ClientHeight = 4095 ClientLeft = 45 ClientTop = 330 ClientWidth = 7815 LinkTopic = "Form1" LockControls = -1 'True MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4095 ScaleWidth = 7815 ShowInTaskbar = 0 'False StartUpPosition = 2 'CenterScreen Begin VB.TextBox txtAddressTO Appearance = 0 'Flat BackColor = &H00FFFFFF& BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 360 Left = 1440 TabIndex = 8 Top = 120 Width = 6210 End Begin VB.CommandButton cmdAttachment BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 290 Left = 120 Style = 1 'Graphical TabIndex = 7 TabStop = 0 'False ToolTipText = "click here to choose attachment file..." Top = 1530 Width = 290 End Begin MSComDlg.CommonDialog CommonDialog1 Left = 90 Top = 2640 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin VB.TextBox txtMsg Appearance = 0 'Flat BackColor = &H00FFFFFF& BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 1960 Left = 1440 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 2 Top = 2025 Width = 6240 End Begin VB.TextBox txtSubject Appearance = 0 'Flat BackColor = &H00FFFFFF& BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 360 Left = 1440 TabIndex = 0 Top = 540 Width = 6240 End Begin VB.CommandButton cmdSendEmail Caption = "Send Email" BeginProperty Font Name = "Tahoma" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 120 TabIndex = 3 Top = 3610 Width = 1110 End Begin VB.Label Label1 Appearance = 0 'Flat BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Caption = " To :" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 330 Index = 0 Left = 120 TabIndex = 9 Top = 120 Width = 1110 End Begin VB.Label lblAttachment Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 750 Left = 1440 TabIndex = 1 ToolTipText = "click here to remove attached file if selected..." Top = 1170 Width = 6240 End Begin VB.Label Label1 Appearance = 0 'Flat BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Caption = " Attach :" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 330 Index = 3 Left = 120 TabIndex = 6 Top = 1170 Width = 1110 End Begin VB.Label Label1 Appearance = 0 'Flat BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Caption = " Message :" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 330 Index = 2 Left = 120 TabIndex = 5 Top = 2025 Width = 1110 End Begin VB.Label Label1 Appearance = 0 'Flat BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Caption = " Subject :" BeginProperty Font Name = "Tahoma" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 330 Index = 1 Left = 120 TabIndex = 4 Top = 540 Width = 1110 End End Attribute VB_Name = "frmSendEmail" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '******************************************************************************* ' MODULE: frmSendEmail ' AUTHOR: Speedy ' ' DESCRIPTION: ' FORM TO SEND EMAIL '******************************************************************************* Private Sub cmdSendEmail_Click() If InStr(2, txtAddressTO, "@", vbTextCompare) = 0 Then MsgBox "invalid TO email address" txtAddressTO.SetFocus Exit Sub End If If Len(txtSubject) <= 0 Then MsgBox "invalid subject" txtSubject.SetFocus Exit Sub End If If Len(txtMsg) <= 0 Then MsgBox "invalid email message" txtMsg.SetFocus Exit Sub End If Me.Hide '* ADD ATTACHMENT FILE IF THE LABEL CONTAINS A SELECTED FILE If Len(lblAttachment) > 0 And lblAttachment > " " Then Call SendMessage(False, lblAttachment) Else Call SendMessage(False) End If Unload Me MsgBox "The email has been sent" End Sub Private Sub cmdAttachment_Click() On Error GoTo ErrHandler lblAttachment = "" ' DISPLAY THE OPEN DIALOG BOX. CommonDialog1.ShowOpen lblAttachment = CommonDialog1.FileName txtMsg.SetFocus Exit Sub ErrHandler: ' USER PRESSED CANCEL BUTTON. Exit Sub End Sub Private Sub Form_Load() Me.Caption = App.Title & " v" & App.Major & "." & App.Minor & "." & App.Revision End Sub Private Sub Form_Unload(Cancel As Integer) On Error Resume Next ' DELETE THE HTML FILE Kill Me.lblAttachment.Caption Unload Me End Sub Private Sub lblAttachment_Click() lblAttachment = "" End Sub Private Sub MenuFileExit_Click() Unload Me End Sub Private Sub MenuHelpAbout_Click() End Sub Private Sub txtAddressTO_GotFocus() Call YellowGotFocus(Me.ActiveControl) End Sub Private Sub txtAddressTO_KeyPress(KeyAscii As Integer) Call ForceUnCaps(KeyAscii) End Sub Private Sub txtAddressTO_Validate(Cancel As Boolean) Call WhiteLostFocus(Me.ActiveControl) End Sub Private Sub txtMsg_Click() If txtMsg = "email message here..." Then txtMsg.SelStart = 0 txtMsg.SelLength = Len(txtMsg) End If End Sub Private Sub txtMsg_GotFocus() Call txtMsg_Click Call YellowGotFocus(Me.ActiveControl) End Sub Private Sub txtMsg_KeyPress(KeyAscii As Integer) Call ForceCaps(KeyAscii) End Sub Private Sub txtMsg_Validate(Cancel As Boolean) Call WhiteLostFocus(Me.ActiveControl) End Sub Private Sub txtSubject_Click() If txtSubject = "email subject here..." Then txtSubject.SelStart = 0 txtSubject.SelLength = Len(txtSubject) End If End Sub Private Sub txtSubject_GotFocus() Call txtSubject_Click Call YellowGotFocus(Me.ActiveControl) End Sub Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath) Dim objOutlook As Outlook.Application Dim objOutlookMsg As Outlook.MailItem Dim objOutlookRecip As Outlook.Recipient Dim objOutlookAttach As Outlook.Attachment ' CREATE THE OUTLOOK SESSION. Set objOutlook = CreateObject("Outlook.Application") ' CREATE THE MESSAGE. Set objOutlookMsg = objOutlook.CreateItem(olMailItem) With objOutlookMsg ' ADD THE TO RECIPIENT(S) TO THE MESSAGE. Set objOutlookRecip = .Recipients.Add(Me.txtAddressTO.Text) objOutlookRecip.Type = olTo ' SET THE SUBJECT, BODY, AND IMPORTANCE OF THE MESSAGE. .Subject = Me.txtSubject.Text .Body = Me.txtMsg.Text .Importance = olImportanceHigh ' HIGH IMPORTANCE ' ADD ATTACHMENTS TO THE MESSAGE. If Not IsMissing(AttachmentPath) Then Set objOutlookAttach = .Attachments.Add(Me.lblAttachment.Caption) End If ' RESOLVE EACH RECIPIENT'S NAME. For Each objOutlookRecip In .Recipients objOutlookRecip.Resolve Next ' SHOULD WE DISPLAY THE MESSAGE BEFORE SENDING? If DisplayMsg Then .Display Else .Save .Send End If End With Set objOutlook = Nothing End Sub Private Sub txtSubject_KeyPress(KeyAscii As Integer) Call ForceCaps(KeyAscii) End Sub Private Sub txtSubject_Validate(Cancel As Boolean) Call WhiteLostFocus(Me.ActiveControl) End Sub