如何按EXCEL表中给出的信息自动发送邮件(带附件），急！

lynn_xiaoyu

在lg的帮助下问题解决，谢谢大家！

hbkeguojin

原帖由 lynn_xiaoyu 于 2009-2-19 01:34 发表
在lg的帮助下问题解决，谢谢大家！

如何解决，请将解决好的原件发上来，供大家学习学习。

lynn_xiaoyu

Private Sub CommandButton1_Click()
Dim objOL As Object
Dim itmNewMail As Object
Dim i
i = 3
Do While Cells(i, 3) <> ""
    Set objOL = CreateObject("Outlook.Application")
    Set itmNewMail = objOL.CreateItem(olMailItem)
    With itmNewMail
        .Subject = Cells(i, 4)
        .Body = Cells(i, 3)
        .to = Cells(i, 2)
        .Attachments.Add "R:\1.txt "
        .Display
        .Send
    End With
    On Error GoTo continue
continue:
    On Error GoTo 0
    Set itmNewMail = Nothing
    Set objOL = Nothing
    i = i + 1
Loop
End Sub
加重装office

feudaemon

您好!

我试了一下,这段代码我有点不明白的是,这三封自动发的邮件发的都是同一个附件"R:\1.txt",而不是excel表里对应的不同附件?

我是新手,请各位多指教,先谢谢了~~

mineshine

Private Sub CommandButton1_Click()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim i As Integer
    For i = 3 To Sheets("Sheet1").[B65536].End(xlUp).Row
        Set OutApp = CreateObject("Outlook.Application")
        OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)
        strbody = Sheets("Sheet1").Range("D" & i).Value    '邮件内容
        '可以省去D栏"邮件内容",以"您好，请查收" +"邮件主题"
        'strbody = "您好，请查收" & Sheets("Sheet1").Range("c" & i).Value
        On Error Resume Next
        With OutMail
            .To = Sheets("Sheet1").Range("B" & i).Value    '邮件地址
            .CC = ""
            .BCC = ""
            .Subject = Sheets("Sheet1").Range("C" & i).Value    '邮件主题
            .Body = strbody   '邮件内容
            If Sheets("Sheet1").Cells(i, 5).Value <> "" Then
                .Attachments.Add Sheets("Sheet1").Cells(i, 5).Value   '邮件附件存放目录(附加文件)
            End If
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
    Next i
End Sub

kanonlee

长见识了
不过我用的lotus，不知道怎么贴图
郁闷

蔡明江

运行时错误 '429':

ActiveX 部件不能创建对象

mineshine

那段代码是使用Microsoft Outlook, 而非Outlook Express
你可以参考下面网页修改代码
http://www.rondebruin.nl/mail/add-in.htm

yb010

学习回来！

leap1213

学习了，明天试试看。。