vb6 - send email with attachment using smtp

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

Attachment 83586


Attachment 83587

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

Not working with me
this message

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

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

thank you

but i have connection with internet

which email provider settings are you using

Server ?
port ?
ssl ?

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

check here

could you post the settings reqd..

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

many thanks for great support it is working now :)

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.

{please delete}

what is this error, any message with it.

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

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

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.

thank you so much for the code :)

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 !!

Thanks
It's very good
:)

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

Quote:

---

Originally Posted by coolcurrent4u

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

---

I've problem with "txtInfo" in :

Code:

---

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

---

Do you have a control array of textboxes called txtInfo?

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

Quote:

---

Originally Posted by 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

---

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

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

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

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

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

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

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

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

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.

:thumb:It works!!!!

Quote:

---

Originally Posted by 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

---

Quote:

---

Originally Posted by coolcurrent4u

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

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

Thank you for help!

Quote:

---

Originally Posted by 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

Attachment 83586


Attachment 83587

---

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 :D

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 :D


#sorry_4_my_bad_english

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

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

Rob

Quote:

---

Originally Posted by 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

---

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?

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

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?

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

Quote:

---

Originally Posted by Kars Lensen

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

---

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

Hello

Any one know how to attach more than one file ?

Thanks

Quote:

---

Originally Posted by Motero69

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 -

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"

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

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

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

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

Quote:

---

Originally Posted by damasterjo

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