Question

我试图自动向excel工作表（工作表4）上的每个收件人生成电子邮件。工作表1包含工作表4单元格B1上的收件人电子邮件的图表表格2在表格4的单元格B2上包含收件人电子邮件的图表 .Sheet 3与上面相同。

我陷入了导出过程，因为当我f8代码时，它导致我出现错误，然后结束。

请帮助，谢谢！

我每张纸上都有一张图表（第1,2,3页）我必须将工作表1上的图表发送给客户1（工作表4上的B1）

子demochart（）

Dim OutApp As Object
Dim OutMail As Object
Dim fname As String
Dim cell As Range
Dim lastrow As Integer
lastrow = Range("A1").End(xlDown).Row
Dim i As Integer

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
    For i = 1 To lastrow
    fname = ThisWorkbook.Path & "\clientchart.gif"
    ActiveWorkbook.Worksheets(i).ChartObjects("chart 1").Chart.Export _
    Filename:=fname, filtername:="GIF"

    If Range("B" & i).Value Like "?*@?*.?*" Then
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = Range("B" & i).Value
            .Subject = "Reminder for" & cell.Offset(0, -1)
            .Body = "Dear " & Cells(cell.Row, "A").Value _
                  & vbNewLine & vbNewLine & _
                    "Please contact us to discuss bringing " & _
                    "your account up to date"
            .Attachments.Add fname
            'You can add files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send  'Or use Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing

    End If
Next i

清理：设置OutApp =无 Application.ScreenUpdating =真结束

每个客户都应该有图表和正文文本

VBA-为列表中的每个收件人生成带有自定义图表的单独电子邮件

0 个答案: