vba excel рассылки писем через outlook

Автор Посетитель, 26 октября 2022, 17:29

Посетитель

Добрый день! По коду формируется письмо с гиперссылкой, которая указана в определенной ячейке таблицы. В сформированном письме гиперссылка не срабатывает, хотя и опознается как гиперссылка (пишет нажмите, чтобы перейти по гиперссылке, но при нажатии ничего не происходит)

Код
Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String, CC As String
    Dim lr As Long, lLastR As Long
    Dim WB As Workbook
    Dim olItem As Object
 
  'Определяет последнюю заполненную строку по столбцу А
  Dim rF As Range
    Dim lLastRow As Long, lLastCol As Long
  Set rF = ActiveSheet.UsedRange.Find("*", , xlValues, xlWhole, , xlPrevious)
    If Not rF Is Nothing Then
        lLastRow = rF.Row
        End If

    'Application.ScreenUpdating = False
    'On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    'произошла ошибка создания объекта - выход
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
    'objOutlookApp.Session.Logon "user","1234",False, True
   
    Set WB = ThisWorkbook
    lLastR = WB.Worksheets("рассылка").Cells(Rows.Count, 3).End(xlUp).Row
        Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
           'цикл от двух строки(начало данных с адресами) до последней ячейки таблицы
            For lr = 2 To lLastR
           sTo = sTo & "; " & WB.Worksheets("рассылка").Cells(lr, 13).Value 'адрес получателя
            Next lr
            For lr = 2 To lLastR
            CC = CC & "; " & WB.Worksheets("рассылка").Cells(lr, 14).Value
            Next lr
            sSubject = "КП по графику_" & WB.Worksheets("рассылка").Cells(2, 8).Value  'тема сообщения
        With objMail
            .To = sTo 'адрес получателя
            .CC = "email1@yandex.ru" & "; " & "email2@yandex.ru" & "; " & CC
            .Subject = sSubject 'тема сообщения
            .htmlbody = "<HTML><BODY> Добрый день! Напоминаю, что сегодня следующие КП за период: " & WB.Worksheets("рассылка").Cells(2, 12).Value
            .htmlbody = .htmlbody & ConvertRngToHTM(WB.Worksheets("рассылка").Range("A1:L" & lLastRow))
            .htmlbody = .htmlbody & "<HTML><BODY> <br> КП просьба сохранять в папку по пути: "
            .htmlbody = .htmlbody & "<a href=' '>" 'начало гиперссылки
            .htmlbody = .htmlbody & " " & WB.Worksheets("Списки").Range("E9").Value
            .htmlbody = .htmlbody & "</a>" 'конец гиперссылки
            .htmlbody = .htmlbody & "<HTML><BODY> <br> <span style=""color:#CC0000""><b>!Важно.</b></span style=""color:#CC0000""> <b>На постоянной основе:</b>"
            .htmlbody = .htmlbody & "<HTML><BODY> <br> После завершения выполнения контрольных процедур необходимо разместить файлы по пути:"
            .htmlbody = .htmlbody & "<a href=' '>" 'начало гиперссылки
            .htmlbody = .htmlbody & " " & WB.Worksheets("Списки").Range("E10").Value
            .htmlbody = .htmlbody & "</a>" 'конец гиперссылки
            .htmlbody = .htmlbody & "<HTML><BODY> <br><br><br><br><br> С наилучшими пожеланиями"
            .htmlbody = .htmlbody & "<HTML><BODY> Налоговая отчетность по НДС"
            .htmlbody = .htmlbody & "<HTML><BODY>  Налоговой службы ОЦО"

            '.Send ' если необходимо отправлять без просмотра
            .Display ' если необходимо просмотреть сообщение, а не отправлять без просмотра
           
        End With
   

    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
   
     
End Sub
[свернуть]

Администратор

Написал вам два письма на почту с заголовком "Письмо с Форума по VBA, Excel и Word". Написал именно на почту, а не на форум.

Вы не указали гиперссылку, вы указали только поясняющий текст для пользователя.
Сама гиперссылка записывается сюда:
.htmlbody = .htmlbody & "<a href=' '>" 'начало гиперссылки
а именно сюда: <a href=' '>
а именно между одинарных кавычек.

Т.е. должно быть так:
.htmlbody = .htmlbody & "<a href='" & WB.Worksheets("Списки").Range("E10").Value  &"'>" 'начало гиперссылки

А здесь у вас записывается поясняющий текст для пользователя, который он видит в письме (это синий текст):
.htmlbody = .htmlbody & " " & WB.Worksheets("Списки").Range("E10").Value

Посетитель

Если вписываю как вы указываете, то гиперссылка не вставляется совсем, а весь текст, который должен быть после гиперссылки становится синим - как будто гиперссылка

Администратор

Для теста попробуйте не подставлять URL из эксель-ячейки, а прямо в код напишите URL какой-нибудь страницы, например Яндекса. Посмотрите, стало нормально.

Т.е. три строки будут выглядеть так:
            .htmlbody = .htmlbody & "<a href='https://forumvba.ru'>" 'начало гиперссылки
            .htmlbody = .htmlbody & "https://forumvba.ru"
            .htmlbody = .htmlbody & "</a>" 'конец гиперссылки

Посетитель

Спасибо огромное! Когда увидела все три строки вместе, поняла, что не правильно вставляла в первый раз :-(