Solved

code for email from prog

Posted on 2000-05-10
11
256 Views
Last Modified: 2013-11-13
i need code for a program to just send mail to a specified address (text1.text).  i am kinda new at this, so comments would be appreciated.  an explanation of what is happening and why you are doing things is needed also.
0
Comment
Question by:blackc
11 Comments
 
LVL 28

Expert Comment

by:AzraSound
ID: 2798544
0
 

Expert Comment

by:ramanan
ID: 2798637
Put a MAPI Session and MAPI Messge controls in the form

'Sign on to a mapi session
MAPISession.SignOn

'Set the session id
MAPIMessages.SessionID = MAPISession.SessionID

'Compose and send the message
MAPIMessages.Compose
                    MAPIMessages.RecipDisplayName = "Guest"
                    MAPIMessages.RecipAddress = "guest@hotmail.com"
                    MAPIMessages.AddressResolveUI = True
                    MAPIMessages.ResolveName
                                        MAPIMessages.MsgSubject = "Testing
                    MAPIMessages.MsgNoteText = "Sending an email through VB'

MAPIMessages.Send False
0
 

Author Comment

by:blackc
ID: 2802235
i don't think i was very clear in my question.  is it possible to simply send an email, without logging onto another system?  or if not, how would i log in to a hotmail account?  the computer this will be run on will not have an outlook or netscape mail system set up, but will have access to a hotmail account.  thanx.
0
 

Accepted Solution

by:
BogdanGrama earned 150 total points
ID: 2802358
Try this my friend
use winsock ocx

Private Enum POP3States
    POP3_Connect
    POP3_USER
    POP3_PASS
    POP3_STAT
    POP3_RETR
    POP3_DELE
    POP3_QUIT
End Enum
Private m_State         As POP3States
Private Sub Con()
    m_State = POP3_Connect
    Winsock1.Close
    Winsock1.LocalPort = 0
    Winsock1.Connect "mail.technapoli.it", 110
End Sub
Private Sub cmdDel_Click()
Unload Me
End Sub
Private Sub Command1_Click()
Form1.Show
End Sub
Private Sub Form_Activate()
Con
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    Static intMessages          As Integer 'the number of messages to be loaded
    Static intCurrentMessage    As Integer 'the counter of loaded messages
    Static strBuffer            As String  'the buffer of the loading message
    Winsock1.GetData strData
       Debug.Print strData
    If Left$(strData, 1) = "+" Or m_State = POP3_RETR Then
        Select Case m_State
            Case POP3_Connect
                intMessages = 0
                m_State = POP3_USER
                Winsock1.SendData "USER " & "finsiel" & vbCrLf
                Debug.Print "USER " & "finsiel"
            Case POP3_USER
                m_State = POP3_PASS
                Winsock1.SendData "PASS " & "finsiel2000" & vbCrLf
                Debug.Print "PASS " & "finsiel2000"
            Case POP3_PASS
                m_State = POP3_STAT
                Winsock1.SendData "STAT" & vbCrLf
                Debug.Print "STAT"
            Case POP3_STAT
                intMessages = CInt(Mid$(strData, 5, InStr(5, strData, " ") - 5))
                If intMessages > 0 Then
                    m_State = POP3_RETR
                    intCurrentMessage = intCurrentMessage + 1
                    Winsock1.SendData "RETR 1" & vbCrLf
                    Debug.Print "RETR 1"
                Else
                    m_State = POP3_QUIT
                    Winsock1.SendData "QUIT" & vbCrLf
                    Debug.Print "QUIT"
                    Winsock1.Close
                    Con
                End If
            Case POP3_RETR
                strBuffer = strBuffer & strData
                If InStr(1, strBuffer, vbLf & "." & vbCrLf) Then
                    strBuffer = Mid$(strBuffer, InStr(1, strBuffer, vbCrLf) + 2)
                    strBuffer = Left$(strBuffer, Len(strBuffer) - 3)
                    MsgBox strBuffer
                    strBuffer = ""
                     If intCurrentMessage = intCurrentMessage Then
                       m_State = POP3_QUIT
                      Winsock1.SendData "DELE 1" & vbCrLf
                      Winsock1.SendData "QUIT" & vbCrLf
                      Debug.Print "QUIT"
                    End If
                End If
            Case POP3_QUIT
                 Winsock1.Close
                 Con
                End Select
    Else
            Winsock1.Close
            Con
            MsgBox "POP3 Error: " & strData, _
            vbExclamation, "POP3 Error"
    End If
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next
'    MsgBox "Winsock Error: #" & Number & vbCrLf & _
'            Description
End Sub




to send mail




Dim Response As String, Reply As Integer, DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String
Dim Start As Single, Tmr As Single



Sub SendEmail(MailServerName As String, FromName As String, _
FromEmailAddress As String, ToName As String, ToEmailAddress As String, _
EmailSubject As String, EmailBodyOfMessage As String)
         
    Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or you can _
only send 1 e-mail pre program start
   
If Winsock1.State = sckClosed Then ' Check to see if socet is closed
    DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") _
& " " & Format(Time, "hh:mm:ss") & "" & " -0600"
    first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get _
who 's sending E-Mail address
    Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who _
mail is going to
    Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
    Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending
    Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf ' Who it going to
    Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of _
E -mail
    Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
    Ninth = "mouse mailer" + vbCrLf ' What program sent the e-mail, _
customize this
    Eighth = Fourth + Third + Ninth + Fifth + Sixth  ' Combine for _
proper SMTP sending

    Winsock1.Protocol = sckTCPProtocol ' Set protocol for sending
    Winsock1.RemoteHost = MailServerName ' Set the server address
    Winsock1.RemotePort = 25 ' Set the SMTP Port
    Winsock1.Connect ' Start connection
   
    WaitFor ("220")
   
    StatusTxt.Caption = "Connecting...."
    StatusTxt.Refresh
   
    Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)

    WaitFor ("250")

    StatusTxt.Caption = "Connected"
    StatusTxt.Refresh

    Winsock1.SendData (first)

    StatusTxt.Caption = "Sending Message"
    StatusTxt.Refresh

    WaitFor ("250")

    Winsock1.SendData (Second)

    WaitFor ("250")

    Winsock1.SendData ("data" + vbCrLf)
   
    WaitFor ("354")


    Winsock1.SendData (Eighth + vbCrLf)
    Winsock1.SendData (Seventh + vbCrLf)
    Winsock1.SendData ("." + vbCrLf)

    WaitFor ("250")

    Winsock1.SendData ("quit" + vbCrLf)
   
    StatusTxt.Caption = "Disconnecting"
    StatusTxt.Refresh

    WaitFor ("221")

    Winsock1.Close
Else
    MsgBox (Str(Winsock1.State))
End If
   
End Sub
Sub WaitFor(ResponseCode As String)
    Start = Timer ' Time event so won't get stuck in loop
    While Len(Response) = 0
        Tmr = Start - Timer
        DoEvents ' Let System keep checking for incoming response _
**IMPORTANT**
        If Tmr > 50 Then ' Time in seconds to wait
            MsgBox "SMTP service error, timed out while waiting for  Response ", 64, MsgTitle
            Exit Sub
        End If
    Wend
    While Left(Response, 3) <> ResponseCode
        DoEvents
        If Tmr > 50 Then
           
        MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
            Exit Sub
        End If
    Wend
Response = "" ' Sent response code to blank **IMPORTANT**
End Sub


Private Sub Command1_Click()
    StatusTxt.Caption = "Sending"
    SendEmail "bucarest.finsiel.ro", "Miruna", "m.bulandra@bucarest.finsiel.ro", "Transact CE", "finsiel@mail.technapoli.it", "interflora" + CStr(Time), "Acesta este mail-ul nr aksjfkh  askf  aksf  kjsg fkjshgad fkjhgasd fkhg al doilea" + CStr(Time)
    StatusTxt.Caption = "Mail Sent"
    StatusTxt.Refresh
    Beep
   
    Close
End Sub

Private Sub Command2_Click()
 Unload Me
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    Winsock1.GetData Response ' Check for incoming response *IMPORTANT*

End Sub


Send a note for more details












0
 

Author Comment

by:blackc
ID: 2802703
i only wish i understood how to utilize that very good information.  can you explain a bit about how to use it?  you will get the points as soon as i can get it to work, and for that much code/effort, i think i will raise the points too.
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Expert Comment

by:BogdanGrama
ID: 2803331
I send you a revision

Let's start from the top

put this in a form

4 textbox
1 listview
1 winsock control


Private Enum POP3States
    POP3_Connect
    POP3_USER
    POP3_PASS
    POP3_STAT
    POP3_RETR
    POP3_DELE
    POP3_QUIT
End Enum

Private m_State         As POP3States

Private m_oMessage      As CMessage
Private m_colMessages   As New CMessages
'

Private Sub cmdCheckMail_Click()
   
    'Check the emptiness of all the text fields except for the txtBody
    For Each c In Controls
        If TypeOf c Is TextBox And c.Name <> "txtBody" Then
            If Len(c.Text) = 0 Then
                MsgBox c.Name & " can't be empty", vbCritical
                Exit Sub
            End If
        End If
    Next
    '
    'Change the value of current session state
    m_State = POP3_Connect
    '
    'Close the socket in case it was opened while another session
    Winsock1.Close
    '
    'reset the value of the local port in order to let to the
    'Windows Sockets select the new one itself
    'It's necessary in order to prevent the "Address in use" error,
    'which can appear if the Winsock Control has already used while the 
    'previous session
    Winsock1.LocalPort = 0
    '
    'POP3 server waits for the connection request at the port 110.
    'According with that we want the Winsock Control to be connected to
    'the port number 110 of the server we have supplied in txtHost field
    Winsock1.Connect txtHost, 110

End Sub



Private Sub cmdDel_Click()
    Unload Me
End Sub

Private Sub lvMessages_ItemClick(ByVal Item As ComctlLib.ListItem)

    txtBody = m_colMessages(Item.Key).MessageBody
   
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    Dim strData As String
   
    Static intMessages          As Integer 'the number of messages to be loaded
    Static intCurrentMessage    As Integer 'the counter of loaded messages
    Static strBuffer            As String  'the buffer of the loading message
    '
    'Save the received data into strData variable
    Winsock1.GetData strData
    Debug.Print strData
   
    If Left$(strData, 1) = "+" Or m_State = POP3_RETR Then
        'If the first character of the server's response is "+" then
        'server accepted the client's command and waits for the next one
        'If this symbol is "-" then here we can do nothing
        'and execution skips to the Else section of the code
        'The first symbol may differ from "+" or "-" if the received
        'data are the part of the message's body, i.e. when
        'm_State = POP3_RETR (the loading of the message state)
        Select Case m_State
            Case POP3_Connect
                '
                'Reset the number of messages
                intMessages = 0
                '
                'Change current state of session
                m_State = POP3_USER
                '
                'Send to the server the USER command with the parameter.
                'The parameter is the name of the mail box
                'Don't forget to add vbCrLf at the end of the each command!
                Winsock1.SendData "USER " & txtUserName & vbCrLf
                Debug.Print "USER " & txtUserName
                'Here is the end of Winsock1_DataArrival routine until the
                'next appearing of the DataArrival event. But next time this
                'section will be skipped and execution will start right after
                'the Case POP3_USER section.
            Case POP3_USER
                '
                'This part of the code runs in case of successful response to
                'the USER command.
                'Now we have to send to the server the user's password
                '
                'Change the state of the session
                m_State = POP3_PASS
                Winsock1.SendData "PASS " & txtPassword & vbCrLf
                Debug.Print "PASS " & txtPassword
            Case POP3_PASS
                '
                'The server answered positively to the process of the
                'identification and now we can send the STAT command. As a
                'response the server is going to return the number of
                'messages in the mail box and its size in octets
                '
                ' Change the state of the session
                m_State = POP3_STAT
                '
                'Send STAT command to know how many
                'messages in the mailbox
                Winsock1.SendData "STAT" & vbCrLf
                Debug.Print "STAT"
            Case POP3_STAT
                '
                'The server's response to the STAT command looks like this:
                '"+OK 0 0" (no messages at the mailbox) or "+OK 3 7564"
                '(there are messages). Evidently, the first of all we have to
                'find out the first numeric value that contains in the
                'server's response
                intMessages = CInt(Mid$(strData, 5, _
                              InStr(5, strData, " ") - 5))
                If intMessages > 0 Then
                    '
                    'Oops. There is something in the mailbox!
                    'Change the session state
                    m_State = POP3_RETR
                    '
                    'Increment the number of messages by one
                    intCurrentMessage = intCurrentMessage + 1
                    '
                    'and we're sending to the server the RETR command in
                    'order to retrieve the first message
                    Winsock1.SendData "RETR 1" & vbCrLf
                    Debug.Print "RETR 1"
                Else
                    'The mailbox is empty. Send the QUIT command to the
                    'server in order to close the session
                    m_State = POP3_QUIT
                    Winsock1.SendData "QUIT" & vbCrLf
                    Debug.Print "QUIT"
                    MsgBox "You have not mail.", vbInformation
                End If
            Case POP3_RETR
                'This code executes while the retrieving of the mail body
                'The size of the message could be quite big and the
                'DataArrival event may rise several time. All the received
                'data stores at the strBuffer variable:
                strBuffer = strBuffer & strData
                '
                'If case of presence of the point in the buffer it indicates
                'the end of the message (look at SMTP protocol)
                If InStr(1, strBuffer, vbLf & "." & vbCrLf) Then
                    '
                    'Done! The message has loaded
                    '
                    'Delete the first string-the server's response
                    strBuffer = Mid$(strBuffer, InStr(1, strBuffer, vbCrLf) + 2)
                    '
                    'Delete the last string. It contains only the "." symbol,
                    'which indicates the end of the message
                    strBuffer = Left$(strBuffer, Len(strBuffer) - 3)
                    '
                    'Add new message to m_colMessages collection
                    Set m_oMessage = New CMessage
                    m_oMessage.CreateFromText strBuffer
                    m_colMessages.Add m_oMessage, m_oMessage.MessageID
                    Set m_oMessage = Nothing
                    '
                    'Clear buffer for next message
                    strBuffer = ""
                    'Now we comparing the number of loaded messages with the
                    'one returned as a response to the STAT command
                    If intCurrentMessage = intMessages Then
                        'If these values are equal then all the messages
                        'have loaded. Now we can finish the session. Due to
                        'this reason we send the QUIT command to the server
                        m_State = POP3_QUIT
                        Winsock1.SendData "QUIT" & vbCrLf
                        Debug.Print "QUIT"
                    Else
                        'If these values aren't equal then there are
                        'remain messages. According with that
                        'we increment the messages' counter
                        intCurrentMessage = intCurrentMessage + 1
                        '
                        'Change current state of session
                        m_State = POP3_RETR
                        '
                        'Send RETR command to download next message
                        Winsock1.SendData "RETR " & _
                        CStr(intCurrentMessage) & vbCrLf
                        Debug.Print "RETR " & intCurrentMessage
                    End If
                End If
            Case POP3_QUIT
                'No matter what data we've received it's important
                'to close the connection with the mail server
                Winsock1.Close
                'Now we're calling the ListMessages routine in order to
                'fill out the ListView control with the messages we've          
                'downloaded
                Call ListMessages
        End Select
    Else
        'As you see, there is no sophisticated error
        'handling. We just close the socket and show the server's response
        'That's all. By the way even fully featured mail applications
        'do the same.
            Winsock1.Close
            MsgBox "POP3 Error: " & strData, _
            vbExclamation, "POP3 Error"
    End If
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
   
    MsgBox "Winsock Error: #" & Number & vbCrLf & _
            Description
           
End Sub

Private Sub ListMessages()

    Dim oMes As CMessage
    Dim lvItem As ListItem
   
    For Each oMes In m_colMessages
        Set lvItem = lvMessages.ListItems.Add
        lvItem.Key = oMes.MessageID
        lvItem.Text = oMes.From
        lvItem.SubItems(1) = oMes.Subject
        lvItem.SubItems(2) = oMes.SendDate
        lvItem.SubItems(3) = oMes.Size
    Next
   
End Sub

I have for you 2 classes to manage
the listview

cmessage.cls

'local variables to hold property values
Private m_strReturnPath      As String
Private m_strReceived        As String
Private m_strSendDate        As String
Private m_strMessageID       As String
Private m_strMessageTo       As String
Private m_strFrom            As String
Private m_strSubject         As String
Private m_strReplyTo         As String
Private m_strSender          As String
Private m_strCC              As String
Private m_strBCC             As String
Private m_strInReplyTo       As String
Private m_strReferences      As String
Private m_strKeywords        As String
Private m_strComments        As String
Private m_strEncrypted       As String
Private m_strMessageText     As String
Private m_strMessageBody     As String
Private m_strHeaders         As String
Private m_lSize              As Long

Public Sub CreateFromText(strMessage As String)

    Dim intPosA         As Integer
    Dim vHeaders        As Variant
    Dim vField          As Variant
    Dim strHeader       As String
    Dim strHeaderName   As String
    Dim strHeaderValue  As String
   
    intPosA = InStr(1, strMessage, vbCrLf & vbCrLf)
    If intPosA Then
        m_strHeaders = Left$(strMessage, intPosA - 1)
        m_strMessageBody = Right$(strMessage, Len(strMessage) - intPosA - 3)
        m_strMessageText = strMessage
    Else
        Err.Raise vbObjectError + 512 + 101, "CMessage.CreateFromText", _
                    "Invalid message format"
        Exit Sub
    End If
   
    vHeaders = Split(m_strHeaders, vbCrLf)
    For Each vField In vHeaders
        strHeader = CStr(vField)
        intPosA = InStr(1, strHeader, ":")
        If intPosA Then
            strHeaderName = LCase(Left$(strHeader, intPosA - 1))
        Else
            strHeaderName = ""
        End If
        strHeaderValue = Trim$(Right$(strHeader, Len(strHeader) - intPosA))
        Select Case strHeaderName
            Case "return-path"
                m_strReturnPath = strHeaderValue
            Case "received"
                m_strReceived = strHeaderValue
            Case "from"
                m_strFrom = strHeaderValue
            Case "sender"
                m_strSender = strHeaderValue
            Case "reply-to"
                m_strReplyTo = strHeaderValue
            Case "to"
                m_strMessageTo = strHeaderValue
            Case "cc"
                m_strCC = strHeaderValue
            Case "bcc"
                m_strBCC = strHeaderValue
            Case "message-id"
                m_strMessageID = strHeaderValue
            Case "in-reply-to"
                m_strInReplyTo = strHeaderValue
            Case "references"
                m_strReferences = strHeaderValue
            Case "keywords"
                m_strKeywords = strHeaderValue
            Case "subject"
                m_strSubject = strHeaderValue
            Case "comments"
                m_strComments = strHeaderValue
            Case "encrypted"
                m_strEncrypted = strHeaderValue
            Case "date"
                m_strSendDate = strHeaderValue
        End Select
    Next
   
End Sub


Public Function CombineMessage() As String

End Function


Public Property Let Headers(ByVal vData As String)
    m_strHeaders = vData
End Property


Public Property Get Headers() As String
    Headers = m_strHeaders
End Property

Public Property Let MessageBody(ByVal vData As String)
    m_strMessageBody = vData
End Property

Public Property Get MessageBody() As String
    MessageBody = m_strMessageBody
End Property

Public Property Let MessageText(ByVal vData As String)
    m_strMessageText = vData
End Property

Public Property Get MessageText() As String
    MessageText = m_strMessageText
End Property

Public Property Let Encrypted(ByVal vData As String)
    m_strEncrypted = vData
End Property

Public Property Get Encrypted() As String
    Encrypted = m_strEncrypted
End Property

Public Property Let Comments(ByVal vData As String)
    m_strComments = vData
End Property

Public Property Get Comments() As String
    Comments = m_strComments
End Property

Public Property Let Keywords(ByVal vData As String)
    m_strKeywords = vData
End Property

Public Property Get Keywords() As String
    Keywords = m_strKeywords
End Property

Public Property Let References(ByVal vData As String)
    m_strReferences = vData
End Property

Public Property Get References() As String
    References = m_strReferences
End Property

Public Property Let InReplyTo(ByVal vData As String)
    m_strInReplyTo = vData
End Property

Public Property Get InReplyTo() As String
    InReplyTo = m_strInReplyTo
End Property

Public Property Let BCC(ByVal vData As String)
    m_strBCC = vData
End Property

Public Property Get BCC() As String
    BCC = m_strBCC
End Property

Public Property Let CC(ByVal vData As String)
    m_strCC = vData
End Property

Public Property Get CC() As String
    CC = m_strCC
End Property

Public Property Let Sender(ByVal vData As String)
    m_strSender = vData
End Property

Public Property Get Sender() As String
    Sender = m_strSender
End Property

Public Property Let ReplyTo(ByVal vData As String)
    m_strReplyTo = vData
End Property

Public Property Get ReplyTo() As String
    ReplyTo = m_strReplyTo
End Property

Public Property Let Subject(ByVal vData As String)
    m_strSubject = vData
End Property

Public Property Get Subject() As String
    Subject = m_strSubject
End Property

Public Property Let From(ByVal vData As String)
    m_strFrom = vData
End Property

Public Property Get From() As String
    From = m_strFrom
End Property

Public Property Let MessageTo(ByVal vData As String)
    m_strMessageTo = vData
End Property

Public Property Get MessageTo() As String
    MessageTo = m_strMessageTo
End Property

Public Property Let MessageID(ByVal vData As String)
    m_strMessageID = vData
End Property

Public Property Get MessageID() As String
    MessageID = m_strMessageID
End Property

Public Property Let SendDate(ByVal vData As String)
    m_strSendDate = vData
End Property

Public Property Get SendDate() As String
    SendDate = m_strSendDate
End Property

Public Property Let Received(ByVal vData As String)
    m_strReceived = vData
End Property

Public Property Get Received() As String
    Received = m_strReceived
End Property

Public Property Let ReturnPath(ByVal vData As String)
    m_strReturnPath = vData
End Property

Public Property Get ReturnPath() As String
    ReturnPath = m_strReturnPath
End Property

Public Property Get Size() As Long
    Size = Len(m_strMessageText)
End Property

and cmessages.cls

'local variable to hold collection
Private mCol As Collection

Public Sub Add(oMessage As CMessage, Optional sKey As String)
   
    If Len(sKey) = 0 Then
        mCol.Add oMessage
    Else
        mCol.Add oMessage, sKey
    End If

End Sub

Public Property Get Item(vntIndexKey As Variant) As CMessage
  Set Item = mCol(vntIndexKey)
End Property

Public Property Get Count() As Long
    Count = mCol.Count
End Property

Public Sub Remove(vntIndexKey As Variant)
    mCol.Remove vntIndexKey
End Sub

Public Property Get NewEnum() As IUnknown
    Set NewEnum = mCol.[_NewEnum]
End Property

Private Sub Class_Initialize()
    Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    Set mCol = Nothing
End Sub

Try now

Bogdan Grama
Finsiel Romania
Bucharest

0
 

Expert Comment

by:BogdanGrama
ID: 2803349
For Mail send

The code is actually pretty simple, it simply uses windows own Winsock to send e-mail via
SMTP. It makes a connection via TCP on port 25 (If you don't understand what TCP and port
25 is, you may consider brushing up on TCP/IP before using this, but it is not a requirement)
and sends basically text to the SMTP mail server. This is what SMTP stands for SIMPLE Mail
Transport Protocol.  I have tried as much as possible to self document the code, so I will
not got into details here. Just look through it and see what you can do.


7 textbox
-from(email adress)-your name
-to                -there name
-subject           -mail server

-body
 
1 winsock control
1 status bar
2 command buttons










Dim Response As String, Reply As Integer, DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String
Dim Start As Single, Tmr As Single



Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
         
    Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail pre program start
   
If Winsock1.State = sckClosed Then ' Check to see if socet is closed
    DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
    first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get who's sending E-Mail address
    Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who mail is going to
    Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
    Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending
    Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf ' Who it going to
    Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
    Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
    Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' What program sent the e-mail, customize this
    Eighth = Fourth + Third + Ninth + Fifth + Sixth  ' Combine for proper SMTP sending

    Winsock1.Protocol = sckTCPProtocol ' Set protocol for sending
    Winsock1.RemoteHost = MailServerName ' Set the server address
    Winsock1.RemotePort = 25 ' Set the SMTP Port
    Winsock1.Connect ' Start connection
   
    WaitFor ("220")
   
    StatusTxt.Caption = "Connecting...."
    StatusTxt.Refresh
   
    Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)

    WaitFor ("250")

    StatusTxt.Caption = "Connected"
    StatusTxt.Refresh

    Winsock1.SendData (first)

    StatusTxt.Caption = "Sending Message"
    StatusTxt.Refresh

    WaitFor ("250")

    Winsock1.SendData (Second)

    WaitFor ("250")

    Winsock1.SendData ("data" + vbCrLf)
   
    WaitFor ("354")


    Winsock1.SendData (Eighth + vbCrLf)
    Winsock1.SendData (Seventh + vbCrLf)
    Winsock1.SendData ("." + vbCrLf)

    WaitFor ("250")

    Winsock1.SendData ("quit" + vbCrLf)
   
    StatusTxt.Caption = "Disconnecting"
    StatusTxt.Refresh

    WaitFor ("221")

    Winsock1.Close
Else
    MsgBox (Str(Winsock1.State))
End If
   
End Sub
Sub WaitFor(ResponseCode As String)
    Start = Timer ' Time event so won't get stuck in loop
    While Len(Response) = 0
        Tmr = Start - Timer
        DoEvents ' Let System keep checking for incoming response **IMPORTANT**
        If Tmr > 50 Then ' Time in seconds to wait
            MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
            Exit Sub
        End If
    Wend
    While Left(Response, 3) <> ResponseCode
        DoEvents
        If Tmr > 50 Then
            MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
            Exit Sub
        End If
    Wend
Response = "" ' Sent response code to blank **IMPORTANT**
End Sub


Private Sub Command1_Click()
    SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
    'MsgBox ("Mail Sent")
    StatusTxt.Caption = "Mail Sent"
    StatusTxt.Refresh
    Beep
   
    Close
End Sub

Private Sub Command2_Click()
   
    End
   
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    Winsock1.GetData Response ' Check for incoming response *IMPORTANT*

End Sub

Try

Bogdan Grama
Finsiel Romania
Bucharest




0
 

Expert Comment

by:BogdanGrama
ID: 2803355
I hope that you don't mind if i've send
you a mail receiver too.

Bogdan Grama
Finsiel Romania
Bucharest






0
 

Expert Comment

by:BogdanGrama
ID: 2809785
Any good?

0
 

Author Comment

by:blackc
ID: 2815641
sorry i kept you waiting so long.  i have been really busy.  i am accepting your answer, and i will print it out and try it as soon as i get the time.  is there an email-address to get a hold of you if it doesn't work  (you know, a typo or somethin)?
0
 

Expert Comment

by:BogdanGrama
ID: 2816501
Any time

bogdan_grama@yahoo.com
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
bigHeights  challenge 13 56
bunnyEars challenge 6 65
mapBully challenge 6 92
How to measure sizes and angles in scanned images ? 3 31
When we want to run, execute or repeat a statement multiple times, a loop is necessary. This article covers the two types of loops in Python: the while loop and the for loop.
Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
This video teaches viewers about errors in exception handling.
The goal of the video will be to teach the user the difference and consequence of passing data by value vs passing data by reference in C++. An example of passing data by value as well as an example of passing data by reference will be be given. Bot…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now