Цикл VBA для просмотра таблицы и экспорта диаграммы в каждое письмо - PullRequest
0 голосов
/ 28 января 2019

Мне нужен файл 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

1 Ответ

0 голосов
/ 28 января 2019

Если по

Как мне получить мой код 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 функциями, я бы рекомендовал квалифицировать все ваших диапазонов.

...