Question

有人可以帮助我。如何发送包含多个附件的电子邮件。我正在使用cdo和SMTP发送邮件为VB6。一切都很好，除了我一次只能发送一个附件。

这是代码

    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

您只传入一个文件。尝试传入一个文件数组并循环遍历数组。或者，因为它看起来像分号分隔所选文件列表，所以尝试只拆分列表......

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

我不知道如何运行vb 6应用程序，但如果这有帮助，请将其标记。

发送包含多个附件的电子邮件vb6

1 个答案: