Link to home
Start Free TrialLog in
Avatar of turloughm
turloughm

asked on

Sending an email from vb

I want to send an email from within vb,I have never done this before,Does anybody have a sample of how this is done.
Regards T
ASKER CERTIFIED SOLUTION
Avatar of waty
waty
Flag of Belgium image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of turloughm
turloughm

ASKER

If there is no outlook express on the client will this code work? should I use Mapi or something
It won't work,
I have other code at work.
I will post it tomorrow
I'm trying to cover all angles
Cheers T
Avatar of Éric Moreau
I have a sample project which I can send you. This application uses Winsock so all you need is an Internet connection.

Here is the form:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form2
   Caption         =   "Form2"
   ClientHeight    =   6045
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5985
   LinkTopic       =   "Form2"
   ScaleHeight     =   6045
   ScaleWidth      =   5985
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtCC
      Height          =   285
      Left            =   1320
      TabIndex        =   13
      Text            =   "<emoreau@s2i.com>"
      Top             =   1560
      Width           =   4455
   End
   Begin VB.TextBox txtEmailBodyOfMessage
      Height          =   2445
      Left            =   1320
      MultiLine       =   -1  'True
      TabIndex        =   11
      Text            =   "Form2.frx":0000
      Top             =   2280
      Width           =   4455
   End
   Begin VB.TextBox txtEmailSubject
      Height          =   285
      Left            =   1320
      TabIndex        =   9
      Text            =   "Test PSP"
      Top             =   1920
      Width           =   2655
   End
   Begin VB.TextBox txtToEmailAddress
      Height          =   285
      Left            =   1320
      TabIndex        =   7
      Text            =   "<emoreau@s2i.com>"
      Top             =   1200
      Width           =   4455
   End
   Begin VB.TextBox txtFromEmailAddress
      Height          =   285
      Left            =   1320
      TabIndex        =   5
      Text            =   "emoreau@s2i.com"
      Top             =   840
      Width           =   2655
   End
   Begin VB.TextBox txtEmailServer
      Height          =   285
      Left            =   1320
      TabIndex        =   4
      Text            =   "mail.s2i.com"
      Top             =   120
      Width           =   2655
   End
   Begin VB.CommandButton Command2
      Caption         =   "Quit"
      Height          =   495
      Left            =   3360
      TabIndex        =   1
      Top             =   5400
      Width           =   1215
   End
   Begin VB.CommandButton Command1
      Caption         =   "Send"
      Height          =   495
      Left            =   2040
      TabIndex        =   0
      Top             =   5400
      Width           =   1215
   End
   Begin MSWinsockLib.Winsock Winsock1
      Left            =   4200
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   327681
   End
   Begin VB.Label Label1
      Caption         =   "CC (address)"
      Height          =   255
      Index           =   1
      Left            =   0
      TabIndex        =   14
      Top             =   1560
      Width           =   1335
   End
   Begin VB.Label Label1
      Caption         =   "Message"
      Height          =   255
      Index           =   6
      Left            =   0
      TabIndex        =   12
      Top             =   2280
      Width           =   1335
   End
   Begin VB.Label Label1
      Caption         =   "Subject"
      Height          =   255
      Index           =   5
      Left            =   0
      TabIndex        =   10
      Top             =   1920
      Width           =   1335
   End
   Begin VB.Label Label1
      Caption         =   "To (address)"
      Height          =   255
      Index           =   4
      Left            =   0
      TabIndex        =   8
      Top             =   1200
      Width           =   1335
   End
   Begin VB.Label Label1
      Caption         =   "From (address)"
      Height          =   255
      Index           =   3
      Left            =   0
      TabIndex        =   6
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label lblStatus
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   4920
      Width           =   5775
   End
   Begin VB.Label Label1
      Caption         =   "E-Mail server"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   2
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'Description:Allows sending of e-mail (SMTP) directly from
'VB app using Winsock, WITH OUT having to buy an expensive
'on component

'//Input Requirements: Server Address (Name or IP), Senders & //Recipeient's Names, Sender & Recipient E-Mail address, Body of //message

Private mstrResponse As String

Private Sub SendEmail(ByVal pstrMailServerName As String, _
                      ByVal pstrFromEmailAddress As String, _
                      ByVal pstrToEmailAddress1 As String, _
                      ByVal pstrToEmailAddress2 As String, _
                      ByVal pstrToEmailAddress3 As String, _
                      ByVal pstrToEmailAddress4 As String, _
                      ByVal pstrToEmailAddress5 As String, _
                      ByVal pstrEmailSubject As String, _
                      ByVal pstrEmailBodyOfMessage As String)
Dim strDateNow As String
Dim strFirst As String
Dim strThird As String
Dim strFourth As String
Dim strFifth As String
Dim strSixth As String
Dim strSeventh As String
Dim strEighth As String
Dim strNinth As String

    Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail per program start

    strDateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0500"
    strFirst = "mail from:" + Chr(32) + pstrFromEmailAddress + vbCrLf ' Get who's sending E-Mail address
    strThird = "Date:" + Chr(32) + strDateNow + vbCrLf ' Date when being sent
    strFourth = "From:" + Chr(32) + pstrFromEmailAddress + vbCrLf ' Who's Sending
    strFifth = "To:" + Chr(32) + _
               IIf(Len(pstrToEmailAddress1) > 0, pstrToEmailAddress1 + "; ", "") + _
               IIf(Len(pstrToEmailAddress2) > 0, pstrToEmailAddress2 + "; ", "") + _
               IIf(Len(pstrToEmailAddress3) > 0, pstrToEmailAddress3 + "; ", "") + _
               IIf(Len(pstrToEmailAddress4) > 0, pstrToEmailAddress4 + "; ", "") + _
               IIf(Len(pstrToEmailAddress5) > 0, pstrToEmailAddress5 + "; ", "") + _
               vbCrLf ' Who it going to
    strSixth = "Subject:" + Chr(32) + pstrEmailSubject + vbCrLf ' Subject of E-Mail
    strSeventh = pstrEmailBodyOfMessage + vbCrLf ' E-mail message body
    strNinth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' What program sent the e-mail, customize this
    strEighth = strFourth + strThird + strNinth + strFifth + strSixth ' Combine for proper SMTP sending

    With Winsock1
        If .State = sckClosed Then ' Check to see if socet is closed
            .Protocol = sckTCPProtocol ' Set protocol for sending
            .RemoteHost = pstrMailServerName ' Set the server address
            .RemotePort = 25 ' Set the SMTP Port
            .Connect ' Start connection
            WaitFor ("220")
            lblStatus.Caption = "Connecting...."
            lblStatus.Refresh
            .SendData ("HELO worldcomputers.com" + vbCrLf)
            WaitFor ("250")
            lblStatus.Caption = "Connected"
            lblStatus.Refresh
            .SendData (strFirst)
            lblStatus.Caption = "Sending Message"
            lblStatus.Refresh
            WaitFor ("250")
'            .SendData (strEmailTo1)
'            WaitFor ("250")
            If Len(pstrToEmailAddress1) > 0 Then
                .SendData ("rcpt to:" + Chr(32) + pstrToEmailAddress1 + vbCrLf)
                WaitFor ("250")
            End If
            If Len(pstrToEmailAddress2) > 0 Then
                .SendData ("rcpt to:" + Chr(32) + pstrToEmailAddress2 + vbCrLf)
                WaitFor ("250")
            End If
            If Len(pstrToEmailAddress3) > 0 Then
                .SendData ("rcpt to:" + Chr(32) + pstrToEmailAddress3 + vbCrLf)
                WaitFor ("250")
            End If
            If Len(pstrToEmailAddress4) > 0 Then
                .SendData ("rcpt to:" + Chr(32) + pstrToEmailAddress4 + vbCrLf)
                WaitFor ("250")
            End If
            If Len(pstrToEmailAddress5) > 0 Then
                .SendData ("rcpt to:" + Chr(32) + pstrToEmailAddress5 + vbCrLf)
                WaitFor ("250")
            End If
            .SendData ("data" + vbCrLf)
            WaitFor ("354")
            .SendData (strEighth + vbCrLf)
            .SendData (strSeventh + vbCrLf)
            .SendData ("." + vbCrLf)
            WaitFor ("250")
            .SendData ("quit" + vbCrLf)
            lblStatus.Caption = "Disconnecting"
            lblStatus.Refresh
            WaitFor ("221")
            .Close
        Else
            MsgBox (Str(.State))
        End If
    End With
End Sub

Sub WaitFor(strResponseCode As String)
Dim sngStart As Single
Dim sngTmr As Single

    sngStart = Timer ' Time event so won't get stuck in loop

    While Len(mstrResponse) = 0
        sngTmr = sngStart - Timer
        DoEvents ' Let System keep checking for incoming response **IMPORTANT**
        If sngTmr > 50 Then ' Time in seconds to wait
            MsgBox "SMTP service error, timed out while waiting for response", 64
            Exit Sub
        End If
    Wend

    sngStart = Timer ' Time event so won't get stuck in loop
    While Left$(mstrResponse, 3) <> strResponseCode
        sngTmr = Timer - sngStart
        DoEvents
        If sngTmr > 50 Then
            MsgBox "SMTP service error, impromper response code. Code should have been: " + strResponseCode + " Code recieved: " + mstrResponse, 64
            Exit Sub
        End If
    Wend

    mstrResponse = "" ' Sent response code to blank **IMPORTANT**
End Sub

Private Sub Command1_Click()
    lblStatus.Caption = ""
    lblStatus.Refresh
    SendEmail txtEmailServer.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtCC.Text, "", "", "", txtEmailSubject.Text, txtEmailBodyOfMessage.Text
    lblStatus.Caption = "Mail Sent"
    lblStatus.Refresh
End Sub

Private Sub Command2_Click()
    End
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Winsock1.GetData mstrResponse ' Check for incoming response *IMPORTANT*
End Sub

Thanks a million Waty