我的代码如下:我用163和126的邮箱都测试过了总是弹出“发送失败”请大伙帮忙看看工程已经引用相关组件,部件创建都没问题因为是一个朋友帮忙写的他说的话在他的电脑上没问题,他是windows2003好像,我的是XPOption ExplicitPrivate Sub Command1_Click()
    If List1.SelCount <= 0 Then Exit Sub    Dim MailBody As String
    
    Dim con As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    Set con = New ADODB.Connection
    con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Text1.Text & ";Extended Properties='Excel 8.0;HDR=Yes;IMEX=1';"
    
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Open "select * from [" & List1.Text & "$]", con, adOpenKeyset, adLockReadOnly, adCmdText
    
    MailBody = "<table border='1'><tr>"
    
    Dim i As Long, j As Long
    
    For i = 0 To rs.Fields.Count - 1
        MailBody = MailBody & "<td>" & rs.Fields(i).Name & "</td>"
    Next
    MailBody = MailBody & "</tr>"
    
    For i = 0 To rs.RecordCount - 1
        MailBody = MailBody & "<tr>"
        
        For j = 0 To rs.Fields.Count - 1
            MailBody = MailBody & "<td>" & rs.Fields(j).Value & "</td>"
        Next
        
        rs.MoveNext
        MailBody = MailBody & "</tr>"
    Next
    
    MailBody = MailBody & "</table>"
    
    
    'MsgBox MailBody
    Dim re
    re = SendMail(Text7.Text, Text6.Text, MailBody, Text2.Text, Text4.Text, Text5.Text, Text3.Text)
    If re Then
        MsgBox "发送成功"
    Else
        MsgBox "发送失败"
    End If
    
    rs.Close
    con.Close
End SubPrivate Sub Command2_Click()
    With CommonDialog1
        .DialogTitle = "请选择Excel文件"
        .CancelError = True
        .Filter = "Excel Files(*.xls)|*.xls"
        On Error Resume Next
        .ShowOpen
        Text1.Text = .FileName
    End With
    
    If Text1.Text = "" Then Exit Sub
    
    Me.MousePointer = 11
    
    Dim objExcel As Excel.Application
    Dim objWork As Excel.Workbook
    Dim objSheet As Excel.Worksheet
    Set objExcel = New Excel.Application
    
    Set objWork = objExcel.Workbooks.Open(Text1.Text)
    
    For Each objSheet In objWork.Worksheets
        List1.AddItem objSheet.Name
    Next
    
    objWork.Close
    objExcel.Quit
    
    Set objExcel = Nothing
    
    Me.MousePointer = 0
End Sub'函数名: SendMail
'作 用:用Jmail组件发送邮件
'参 数:
' MailtoAddress -----收信人信箱
' Subject -----主题
' MailBody -----信件内容
' MailFrom -----发信人信箱
' MailServerUser -----登陆邮箱用户名
' MailServerPass -----登陆邮箱密码
' MailServer -----发件SMTP服务器
'**************************************************
Function SendMail(MailtoAddress, Subject, MailBody, MailFrom, MailServerUser, MailServerPass, MailServer)
' on error resume next
    Dim JMail As JMail.Message, JMailstat
    Set JMail = CreateObject("JMail.Message")
    
    If Err Then
        Err.Clear
       JMail.Close
       Set JMail = Nothing
       Exit Function
    End If
    
    JMail.Charset = "gb2312" '邮件字符集
    JMail.Silent = True '忽略错误
    JMail.ContentType = "text/html" '邮件编码
    JMail.AddRecipient MailtoAddress '收件人地址
    
    'JMail.ReturnReceipt = True '是否收条(验证中)
    JMail.From = MailFrom '发件人邮箱
    'JMail.MailDomain = MailDomain '邮箱所在域名(验证中)
    'JMail.FromName = FromName '发件人姓名
    JMail.MailServerUserName = MailServerUser '邮箱用户名
    JMail.MailServerPassWord = MailServerPass '邮箱密码
    JMail.Subject = Subject '邮件主题
    'JMail.Body = MailBody '邮件正文(纯文本格式)
    JMail.HTMLBody = MailBody '邮件正文(HTML格式)
    'JMail.Priority = 3 '邮件等级,1为加急,3为普通,5为低级
    
    JMailstat = JMail.Send(MailServer)
    
    If JMailstat Then
        SendMail = True
    Else
        SendMail = False
    End If
    JMail.Close
    Set JMail = Nothing
End Function