将本工作簿以附件形式发送到列表中的邮箱

danielwotcha

高手帮忙修改下，我写了用outlook发送邮件的代码，需要修改一下。现在不打开outlook的话，邮件发不出去。

可以用加载宏、outlook、foxmail、Jmail或者别的，但要方便安装。

我想实现：
点击工具栏的发送，就将本工作簿(整个工作簿，包括所有工作表)，以附件形式发送到sheet2的收件人地址邮箱。
工作簿有sheet1,sheet2：sheet1是数据；sheet2有收件人1地址，收件人2地址，收件人3地址，收件人4地址··· 发送邮件.rar (19.75 KB, 下载次数: 4)

2010-10-31 16:17 上传

点击文件名下载附件

[ 本帖最后由 danielwotcha 于 2010-10-31 16:24 编辑 ]

taotu

Private Sub Command1_Click()

    Dim objEmail As Object

    Set objEmail = CreateObject("CDO.Message")

    objEmail.From = "58886605@qq.com"
    '发件人信箱

    objEmail.To = "5555567@qq.com"
    '收件人信箱

    objEmail.Subject = "邮件主题"

    objEmail.TextBody = "邮件正文"

    objEmail.AddAttachment "d:\kk.txt"                                    '附件内容

   
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.qq.com"

    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
     'SMTP服务器端口

    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "用户名"

    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "密码"

    objEmail.Configuration.Fields.Update

    objEmail.Send

End Sub

danielwotcha

这个行是行，可不大合适啊。