Sending email with multiple attachments vb6

Question

Can someone help me.How to send an email with multiples attachments. I am using cdo and SMTP Send Mail for VB6. Everything works great except I am only able to send one attachment at a time.

here's the code

    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

        On Error GoTo SendMail_Error:
        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) = 30
        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
        lobj_cdomsg.Send
        Set lobj_cdomsg = Nothing
        SendMail = "ok"
        Exit Function

    SendMail_Error:
        SendMail = Err.Description
    End Function


    Private Sub cmdSend_Click()

        Dim retVal          As String
        Dim objControl      As Control

        For Each objControl In Me.Controls
            If TypeOf objControl Is TextBox Then
                If Trim$(objControl.Text) = vbNullString And LCase$(objControl.Name) <> "txtAttach" Then
                    Label2.Caption = "Error: All fields are required!"
                    Exit Sub
                End If
            End If
        Next


        Frame1.Enabled = False
        Frame2.Enabled = False
        cmdSend.Enabled = False
        Label2.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
        Label2.Caption = IIf(retVal = "ok", "Message sent!", retVal)

    End Sub


Private Sub cmdBrowse_Click()

    Dim sFilenames()    As String
    Dim i               As Integer

    On Local Error GoTo Err_Cancel

    With cmDialog
        .FileName = ""
        .CancelError = True
        .Filter = "All Files (*.*)|*.*|HTML Files (*.htm;*.html;*.shtml)|*.htm;*.html;*.shtml|Images (*.bmp;*.jpg;*.gif)|*.bmp;*.jpg;*.gif"
        .FilterIndex = 1
        .DialogTitle = "Select File Attachment(s)"
        .MaxFileSize = &H7FFF
        .Flags = &H4 Or &H800 Or &H40000 Or &H200 Or &H80000
        .ShowOpen
        ' get the selected name(s)
        sFilenames = Split(.FileName, vbNullChar)
    End With

    If UBound(sFilenames) = 0 Then
        If txtAttach.Text = "" Then
            txtAttach.Text = sFilenames(0)
        Else
            txtAttach.Text = txtAttach.Text & ";" & sFilenames(0)
        End If
    ElseIf UBound(sFilenames) > 0 Then
        If Right$(sFilenames(0), 1) <> "\" Then sFilenames(0) = sFilenames(0) & "\"
        For i = 1 To UBound(sFilenames)
            If txtAttach.Text = "" Then
                txtAttach.Text = sFilenames(0) & sFilenames(i)
            Else
                txtAttach.Text = txtAttach.Text & ";" & sFilenames(0) & sFilenames(i)
            End If
        Next
    Else
        Exit Sub
    End If

Err_Cancel:

End Sub

Answer 1

You are only passing in one file. Try passing in an array of files and loop through the array. Or, since it looks like its semicolon delimiting the list of files selected, try to just split the list...

For Each s As String in sFilePath.Split(";"c)
    lobj_cdomsg.AddAttachemt(s)
Next

I have no idea how to run a vb 6 app anymore, but if this helps, please mark it so.