добавить тело письма из Excel Range VBA - PullRequest
Новая
       12

добавить тело письма из Excel Range VBA

0 голосов
/ 10 мая 2018

У меня есть база данных, только с именами и адресами электронной почты, и мне нужно создавать отдельные электронные письма с определенным фиксированным текстом, который находится в определенном диапазоне моего Excel, и сохранять его в определенной папке моего жесткого диск.

Однако у меня проблемы с основным текстом.

Вот это код: 

Sub test()
Dim Sendrng As Range
Dim outlookApp As Outlook.Application
Dim outlookMail As Outlook.MailItem
Dim i As Integer


For i = 2 To ActiveSheet.Cells(5, 2).Value + 1

    Set Sendrng = ActiveSheet.Range("B12:K29")
    Set outlookApp = New Outlook.Application
    Set outlookMail = outlookApp.CreateItem(olMailItem)
    With outlookMail
        .To = ActiveSheet.Cells(7, 2).Value
        .Subject = ActiveSheet.Cells(8, 2).Value
        '.HTMLBody = Sendrng
        .Save
    End With

    i = i + 1

    ActiveSheet.Cells(4, 2) = i

    Set outlookMail = Nothing
    Set outlookApp = Nothing

Next i

'I want to start every time in position 2
ActiveSheet.Cells(4, 2) = 2

End Sub

Можете ли вы объяснить мне, где не хватает? Я получаю следующую ошибку: Ошибка выполнения 13: Несоответствие типов

Спасибо, Henrique

1 Ответ

0 голосов
/ 11 мая 2018

Вам необходимо использовать свойство Text класса Range вместо Value: 

Sub test()
  Dim Sendrng As Range
  Dim outlookApp As Outlook.Application
  Dim outlookMail As Outlook.MailItem
  Dim i As Integer


  For i = 2 To ActiveSheet.Cells(5, 2).Value + 1
    Set Sendrng = ActiveSheet.Range("B12:K29")
    Set outlookApp = New Outlook.Application
    Set outlookMail = outlookApp.CreateItem(olMailItem)
    With outlookMail
      .To = ActiveSheet.Cells(7, 2).Text
      .Subject = ActiveSheet.Cells(8, 2).Text
      .Save
    End With
    i = i + 1
    ActiveSheet.Cells(4, 2) = i
    Set outlookMail = Nothing
    Set outlookApp = Nothing

  Next i

 'I want to start every time in position 2
 ActiveSheet.Cells(4, 2) = 2

End Sub
...