Question

我需要一个Excel文件才能将导出的图表通过电子邮件发送给不同数量的联系人。对于每封电子邮件，都需要重新过滤图表。我想出了如何通过创建带有滚动条的动态图表来执行此操作的方法，并且在循环的每次迭代中，我将在13到达其位置（p）。

如何获取我的VBA代码以将包含导出图表的电子邮件发送到第2列中的任何内容？目前，它也仅发送一封电子邮件，而不是列中的许多电子邮件。任何帮助都会很棒。

Private Sub Workbook_Open()
   Dim b1 As Workbook, b2 As Workbook
   Dim sh As Worksheet

   Set b1 = ThisWorkbook

    Dim olApp As Object
    Dim olMail As Object
    Dim i As Long
    Dim p As Integer
    Dim email As Range
    Dim book As Range

    Set olApp = CreateObject("Outlook.application")
    Set olMail = olApp.createitem(i)
    Set book = Range("A1:B9")
    p = 1

    'START LOOP
    For Each email In book.Rows
        Sheets("nothing").Range("B1").Select
        ActiveCell.FormulaR1C1 = p

        Worksheets(1).ChartObjects(1).Activate
        ActiveChart.Export "testchartlocation.png"

        With olMail
            .To = "test@email.com"
            .Subject = "Emailer Testing..."
            .HTMLbody = "<html><p>Testing...</p><img src='testchartlocation.png'>"
            .display
        End With
        p = p + 13
        Application.Wait (Now + TimeValue("0:00:01"))
    Next
    'END LOOP

    'ThisWorkbook.Close False

End Sub

Answer 1

如果通过

如何获取我的VBA代码以将包含导出图表的电子邮件发送到第2列中有什么？

您的意思是您存储在第2列中的电子邮件地址，每次迭代都需要访问该电子邮件地址才能将导出的图表发送到该地址，您可以更改此行

.To = "test@email.com"

收件人

.To = Cells(email.Row, 2) '<-Make sure to qualify this range with whatever worksheet you're pulling from

关于您的电子邮件仅生成一次的问题，您需要移动

Set olMail = olApp.createitem(i) '<- you can change `i` to `0`

进入For-Next循环的开头，然后像下面那样将其设置为Nothing

For Each email In book.Rows
    Set olMail = olApp.createitem(0)
    'Do Stuff
    Set olMail = Nothing
Next email

这样，每次迭代都会生成一封新电子邮件。

编辑：

您可能会摆脱这一行

Sheets("nothing").Range("B1").Select

然后替换

ActiveCell.FormulaR1C1 = p

使用

Sheets("nothing").Range("B1").FormulaR1C1 = p

由于您正在使用多个工作表和.Activate功能，因此建议您对范围的全部进行限定。

VBA Loop遍历表格并将图表导出到每封电子邮件

1 个答案: