發送帶有多個附件的電子郵件vb6

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應用程序，但如果這能幫助，請如此標記。