Отправка электронной почты с адресами на листе с VBA - PullRequest
1 голос
/ 19 июня 2019

У меня есть лист с именем «Тест», где в столбце А приведен список адресов электронной почты.Я хочу отправить электронное письмо на все адреса и использовать следующий код

Sub EmailSend()

Dim objOutlook As Object
Dim objMail As Object
Dim i As Integer


Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)


For i = 1 To 10


With objMail
   .to = Sheets("Test").Range("A" & i).Value
   .Subject = "hi"
   .body = _ 
      "Hi " & Sheets("Test").Range("B" & i) & Sheets("links").Range("G" & 1)
   .send
End With
Next i


End Sub

К сожалению, makro отправляет электронное письмо только на адрес в A1, и тогда в строке .to = Sheets("Test").Range("A" & i).Value появляется ошибкаСообщение об ошибке гласит: элемент был перемещен или удален.

Есть идеи, что я сделал не так?

1 Ответ

2 голосов
/ 19 июня 2019

Полагаю, во второй строке, которую вы пытаетесь отправить, может быть ошибка.Поэтому используйте приведенный ниже код и проверьте, что он показывает в окне «Немедленно».

ОБНОВЛЕНИЕ: Я добавил строку CreateItem в цикле For и сбрасываю ее для каждого письма.Возможно, это сообщение электронной почты, на которое жалуется сообщение об ошибке.

Sub EmailSend()

Dim objOutlook As Object
Dim objMail As Object
Dim i As Integer

Set objOutlook = CreateObject("Outlook.Application")

For i = 1 To 10
Set objMail = objOutlook.CreateItem(0)

With objMail
    Debug.Print Sheets("Test").Range("A" & i).Value
   .to = Sheets("Test").Range("A" & i).Value
   .Subject = "hi"
   .body = _
      "Hi " & Sheets("Test").Range("B" & i) & Sheets("links").Range("G" & 1)
   .display
   '.send
End With
Set objMail = Nothing

Next i

End Sub
...