# VBForums CodeBank > CodeBank - Visual Basic 6 and earlier >  vb6 - send email with attachment using smtp

## coolcurrent4u

This little project sends email with attachment, using ssl if required.
Some part of the code is not mine, but i made this for most people who still find is difficult to send email in vb6, so they can use as a template. it is simple and straight forward




SendEmail.zip

----------


## DanielT

Tested and working! thanks man!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

----------


## sfaham

Not working with me 
this message

----------


## sfaham

i am soory 
this message "the transport failed to connect the server"

----------


## coolcurrent4u

hello,
welcome to the forums, i think you should check your 
logon on credentials, 
your Internet connection.

----------


## sfaham

thank you

but i have connection with internet

----------


## coolcurrent4u

which email provider settings are you using

Server ?
port ?
ssl ?

----------


## sfaham

mailman.SmtpHost = smtp.gmail.com
mailman.SmtpPort = 465
mailman.SMTPSSL = 1

----------


## coolcurrent4u

check here

----------


## VBFnewcomer

could you post the settings reqd..

----------


## sfaham

Thank you very much for your support and I will give you the experience and the result  :wave:

----------


## sfaham

many thanks for great support it is working now  :Smilie:

----------


## sadell

Hi everybody!
this project works for gmail, but it doesn't works for microsoftonline smtp server.

smtp server: smtp.mail.emea.microsoftonline.com
port: 587
with SSL

The error: -2147220973

The user and pwd are correct. I cant use them for configure client.

If I can't do it with CDO.Message, how can do it?

I'm hopeless.

Could anybody help me, please?

Thanks in advance.

Sonia.

----------


## coolcurrent4u

{please delete}

----------


## coolcurrent4u

what is this error, any message with it.

----------


## sadell

The error is: -2147220973  - Transport error in server conection.

I think, CDO doesn't support SSL/TLS authentication.

----------


## coolcurrent4u

it does support ssl, this app was tested with gmail before posting. make sure that you enable pop access in your email account online first before using the app, and also make sure that you password is correct.

----------


## malek2610

thank you so much for the code  :Smilie: 

it works good when I run it on VB, but when I try to make an exe file it doesn't work, I get this messege

Compile Error :

Sub or Function not defined

Can you help me please !!

----------


## PowerProg

Thanks
It's very good
 :Smilie:

----------


## coolcurrent4u

@malek2610 i did get that error when i compiled, shich sub or function did it complain about?

----------


## malek2610

> @malek2610 i did get that error when i compiled, shich sub or function did it complain about?


I've problem with   "*txtInfo*" in :



```
Private Sub txtInfo_GotFocus(Index As Integer)
    txtInfo(Index).SelStart = 0
    txtInfo(Index).SelLength = Len(txtInfo(Index))
End Sub
```

----------


## Hack

Do you have a control array of textboxes called txtInfo?

----------


## coolcurrent4u

Hello, Please delete this code, its ambiguous 


vb Code:
Private Sub txtInfo_GotFocus(Index As Integer)
    txtInfo(Index).SelStart = 0
    txtInfo(Index).SelLength = Len(txtInfo(Index))
End Sub

----------


## malek2610

> Hello, Please delete this code, its ambiguous 
> 
> 
> vb Code:
> Private Sub txtInfo_GotFocus(Index As Integer)
>     txtInfo(Index).SelStart = 0
>     txtInfo(Index).SelLength = Len(txtInfo(Index))
> End Sub


Thank you so much, now it works without any problem   :Big Grin:

----------


## adie362

you have done an outstanding job, thanks 

please could you let me know how to send 3 x pdf atachments from this e-mailer

kind regards

Adie

----------


## jmsrickland

I don't know how the rest of you got it to work but I sure don't have any luck with it. I just can't get it to work when using the server smtp.live.com. The port is at 465, Req SSL is checked, username and password are correct and my from email is correct. I always get the same error The transport failed to connect to the server

----------


## brss

Need Help,
     I have below code i want to record in each sheet only 50 data. Can anyone help me.

    Private Sub print()


    Dim cnn As New ADODB.Connection
    Dim xlApp1 As New Excel.Application
    Dim xlwk As New Excel.Workbook
    Dim xlSheet1 As New Excel.Worksheet
    Dim xlSheet2 As New Excel.Worksheet
    Dim ctr As Long
    Dim SQL As String
    Dim rs

    cnn.ConnectionTimeout = 15
    cnn.CommandTimeout = 30

    g_strDBName = dbPath & "\BarqCell Data\DSS.mdb"
    'creates a new databse conection and sets the conection string
    Set cnn = New ADODB.Connection
    Constring = "Provider=Microsoft.Jet.OLEDB.4.0; " & _
    "Data Source=" & g_strDBName
    cnn.ConnectionString = Constring
    'Opens the database conection

    cnn.Open

    If DTPicker1.Value = "" Then
    MsgBox "please select date"
    Exit Sub
    End If

    SQL = "select number from tblWarehouse_Received where date =#" & DTPicker1.Value & "#"
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Open SQL, cnn, adOpenDynamic, adLockOptimistic

    xlApp1.Interactive = True

    Set xlwk = xlApp1.Workbooks.Open(App.Path & "\Asia.xls")
    Set xlSheet1 = xlwk.Worksheets("Asia1")
    xlSheet1.Select
    Set xlSheet2 = xlwk.Worksheets("Sheet2")
    xlSheet2.Select
    xlSheet1.Range("B6").Value = Date
    xlSheet2.Range("B6").Value = Date
    ctr = 9 ' start data after headings

i think i made wrong in below code could you please fix it to me. so i can record only 50data in each sheet.
    Do While Not rs.EOF
    ctr = ctr + 1
    If ctr <= 50 Then xlSheet1.Range("B" & Trim(Str(ctr))).Value = rs("number")
    If ctr > 50 And ctr <= 100 Then xlSheet2.Range("B" & Trim(Str(ctr))).Value = rs("number")
    rs.MoveNext

    Loop


    xlApp1.Visible = True

    'xlwk.Save
    'xlApp.Quit

    'handleError:
    ' If err.Number <> 0 Then
    ' MsgBox "Error #: " & err.Number & vbCrLf & err.Description, vbCritical, "Critical Error"
    ' End If

    End Sub

----------


## coolcurrent4u

pls post you question the the vb6 general forum, not here

----------


## brss

I already did. Sorry for confusing. I did post it here by mistake. Thank you for understand and your time to replay me.

----------


## JackSun

I am running VB6 on windows 7 ultimate with office 2010
I run the program and it gives an error:

The message could not be sent to the SMTP server. The transport error code was 0x80040217. The server response was not available

Can anybody help

----------


## coolcurrent4u

check you connection , make sure your gmail password is correct, try it in another computer, then post the result here

----------


## MBen

Works OK for Yahoo and Gmail. Errors appear if use Hotmail or Exchange.  Machine used: PC with Windows 7 Enterprise, Office 2010 Pro installed and exchange used for other stuff.

----------


## lbusekros@gmx.de

:Thumb: It works!!!! 


> This little project sends email with attachment, using ssl if required.
> Some part of the code is not mine, but i made this for most people who still find is difficult to send email in vb6, so they can use as a template. it is simple and straight forward

----------


## 22012782

> check you connection , make sure your gmail password is correct, try it in another computer, then post the result here


Have the same problem here... When i try using smtp.gmail.com, it works. But when i try using my smtp server, it failed

I've tried using the same smtp setting in my microsoft outlook, and it works.  So that mean there is no problem with my setting and smpt connection

note : I use Webmail smtp

Need help please...

thanks before

----------


## Loech

I 'd like to download the sendemail.zip, but it does not work. What's wrong?

Thank you for help!

----------


## Nope

> This little project sends email with attachment, using ssl if required.
> Some part of the code is not mine, but i made this for most people who still find is difficult to send email in vb6, so they can use as a template. it is simple and straight forward
> 
> 
> 
> 
> SendEmail.zip


cool : i try to remake on a new project, but .. 
there is an error on "Dim lobj_cdomsg      As CDO.Message"

and yellow highlighted "Public Function SendMail(sTo As String, sSubject As String, sFrom As String, _
    sBody As String, sSmtpServer As String, iSmtpPort As Integer, _
    sSmtpUser As String, sSmtpPword As String, _
    sFilePath As String, bSmtpSSL As Boolean) As String"

how can i fix this ? please help me  :wave:  
#my_bad_english sorry  :Big Grin:

----------


## Nope

an error appears on 
"Public Function SendMail(sTo As String, sSubject As String, sFrom As String, _
    sBody As String, sSmtpServer As String, iSmtpPort As Integer, _
    sSmtpUser As String, sSmtpPword As String, _
    sFilePath As String, bSmtpSSL As Boolean) As String" 
trying to remake .. but i made a function from command5_click()'s code..

and VB highlighted "Dim lobj_cdomsg      As CDO.Message" 
please help me  :Big Grin: 


#sorry_4_my_bad_english

----------


## Romeo91

Nope, try to install this
Microsoft Exchange Server MAPI Client and Collaboration Data Objects 1.2.1 
http://www.microsoft.com/en-us/downl....aspx?id=36771

----------


## Bobbles

Thank you,
This is working for me.
I would appreciate it if someone could illustrate how to use BCC with this

Rob

----------


## damasterjo

> I am running VB6 on windows 7 ultimate with office 2010
> I run the program and it gives an error:
> 
> The message could not be sent to the SMTP server. The transport error code was 0x80040217. The server response was not available
> 
> Can anybody help


Ok I have used this code and have the same error.
using gmail, smpt.gmail.com port 465

i have used 3 machines for test, windows 7 64bit windows 8.1 64 bit, windows xp.
same error. password is correct

any ideas?

----------


## damasterjo

i just set up a new gmail and its fine... go figure...

----------


## Chippy088

I had a working email client a few years back. Then it started throwing errors. I followed recommendations on this this thread, and changed everything that was recommended. It didn't correct the errors. I have checked with Hotmail(outlook now), g-mail and yahoo, and the reason is that this function alone does not comply with security measure now implemented in their web mail clients.

Has anyone got it to work against these new security parameters?

----------


## Kars Lensen

Use this:
https://www.google.com/settings/security/lesssecureapps

----------


## Bobbles

> Use this:
> https://www.google.com/settings/security/lesssecureapps


You should be getting (much) more praise for sharing this tip
Thanks,
rob

----------


## Motero69

Hello

Any one know how to attach more than one file ?

Thanks

----------


## Bobbles

> Hello
> Any one know how to attach more than one file ?
> Thanks


Yes
I have had this project on my PC for a while, and had changed the data to use my own email provider (iPrimus in australia) 
But that should not effect the code.
I have enhanced the code to handle multiple attachments, by allowing you to add more file names, separated with comma's
Here is the modified code -


```
Option Explicit


Public Function SendMail(sTo As String, sSubject As String, sFrom As String, _
    sBody As String, sSmtpServer As String, iSmtpPort As Integer, _
    sSmtpUser As String, sSmtpPword As String, _
    sFilePathAndFiles As String, bSmtpSSL As Boolean) As String
      
    On Error GoTo SendMail_Error:
    '20171105
    Dim sArr() As String, sFilePathONLY As String, sFiles As String, i As Integer, sFileNameWithPath As String
    Dim lobj_cdomsg      As CDO.Message
    Set lobj_cdomsg = New CDO.Message
    lobj_cdomsg.Configuration.Fields(cdoSMTPServer) = sSmtpServer
    lobj_cdomsg.Configuration.Fields(cdoSMTPServerPort) = iSmtpPort
    lobj_cdomsg.Configuration.Fields(cdoSMTPUseSSL) = bSmtpSSL
    lobj_cdomsg.Configuration.Fields(cdoSMTPAuthenticate) = cdoBasic
    lobj_cdomsg.Configuration.Fields(cdoSendUserName) = sSmtpUser
    lobj_cdomsg.Configuration.Fields(cdoSendPassword) = sSmtpPword
    lobj_cdomsg.Configuration.Fields(cdoSMTPConnectionTimeout) = 60      'WAs 30  I changed to 60 20170910 15:47
    lobj_cdomsg.Configuration.Fields(cdoSendUsingMethod) = cdoSendUsingPort
    lobj_cdomsg.Configuration.Fields.Update
    lobj_cdomsg.To = sTo
    lobj_cdomsg.From = sFrom
    lobj_cdomsg.Subject = sSubject
    lobj_cdomsg.TextBody = sBody
    'If Trim$(sFilePath) <> vbNullString Then
    '    lobj_cdomsg.AddAttachment (sFilePath)
    'End If
    '20171105 Enhanced to cater for multiple attachments
    If Trim$(sFilePathAndFiles) <> vbNullString Then
        If InStr(1, sFilePathAndFiles, ",") Then
            'Multiple attachements are present, so split the filenames (assumption that they are all in the same folder)
            sArr = Split(sFilePathAndFiles, "\")
            sFiles = sArr(UBound(sArr))
            'Remove the File names from sFilePathAndFiles
            sFilePathONLY = Replace(sFilePathAndFiles, sFiles, "")
            sArr = Split(sFiles, ",")
            For i = 0 To UBound(sArr)
                sFileNameWithPath = (sFilePathONLY & sArr(i))
                lobj_cdomsg.AddAttachment sFileNameWithPath
            Next i
        Else
            'There is only one file to attach
            sFileNameWithPath = (sFilePathAndFiles)
            lobj_cdomsg.AddAttachment (sFilePathAndFiles)
        End If
    End If
    
    
    lobj_cdomsg.Send
    Set lobj_cdomsg = Nothing
    SendMail = "ok"
    Exit Function
          
SendMail_Error:
    Debug.Print sFileNameWithPath
    Debug.Print Err.Description
    SendMail = Err.Description
End Function


Private Sub cmdSend_Click()
    
    Dim retVal          As String
    Dim objControl      As Control
    'Validate first
    For Each objControl In Me.Controls
        If TypeOf objControl Is TextBox Then
            If Trim$(objControl.Text) = vbNullString And LCase$(objControl.Name) <> "txtattach" Then
                lblStatus.Caption = "Error: All fields are required!"
                Exit Sub
            End If
        End If
    Next
    
    'Send
    Frame1.Enabled = False
    Frame2.Enabled = False
    cmdSend.Enabled = False
    lblStatus.Caption = "Sending..."
    retVal = SendMail(Trim$(txtTo.Text), _
        Trim$(txtSubject.Text), _
        Trim$(txtFromName.Text) & "<" & Trim$(txtFromEmail.Text) & ">", _
        Trim$(txtMsg.Text), _
        Trim$(txtServer.Text), _
        CInt(Trim$(txtPort.Text)), _
        Trim$(txtUsername.Text), _
        Trim$(txtPassword.Text), _
        Trim$(txtAttach.Text), _
        CBool(chkSSL.Value))
    Frame1.Enabled = True
    Frame2.Enabled = True
    cmdSend.Enabled = True
    lblStatus.Caption = IIf(retVal = "ok", "Message sent!", retVal)
    
End Sub

Private Sub Form_Load()
    'txtAttach.Text = App.Path & "\" & "Test_CDO_email.txt"
    txtAttach.Text = App.Path & "\" & "Test_CDO_email.txt,Test_CDO_email_File_2.txt,Test_CDO_email_File_3.txt"
End Sub

'ROBs   Place error message into clipboard, by clicking the Status Label
Private Sub lblStatus_Click()
    Clipboard.Clear
    Clipboard.SetText lblStatus.Caption
End Sub
```

Rob
PS I am on many occasions getting this error, but it does not happen all the time, so I assume it is my email host telling me to bug off -
"The message could not be sent to the SMTP server. The transport error code was 0x80040217. The server response was not available"

----------


## vb6-Dino

Hi,

I have tried send email with attachment and it works very well.
How can I insert several attachments?
Could you still integrate a progressbar?

greetings

----------


## vb6-Dino

Hi,

I have tried send email with attachment and it works very well.
How can I insert several attachments?
Could you still integrate a progressbar?

greetings

----------


## vb6-Dino

Sorry!
I have overlooked the post before.
Only the topic "Progressbar" remains

----------


## Deaux

For Gmail account set this:
Allow less secure apps: ON

----------


## Deaux

> Ok I have used this code and have the same error.
> using gmail, smpt.gmail.com port 465
> 
> i have used 3 machines for test, windows 7 64bit windows 8.1 64 bit, windows xp.
> same error. password is correct
> 
> any ideas?


For Gmail set:
Allow less secure apps: ON

----------

