Импортировать слишком много информации в электронную почту - PullRequest
Новая
       0

Импортировать слишком много информации в электронную почту

0 голосов
/ 12 февраля 2020

У меня есть электронная таблица со списком электронных писем и необходимой мне информацией. Структура столбца таблицы в электронной таблице выглядит следующим образом: 

Email | Irrelevant Information | Relevant Information

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

Sub EmailRange()

Dim WorkRng As Range
For i = 2 To Ubound 'starting at 2 to skip column headers
    On Error Resume Next
    Set WorkRng = Worksheets("Sheet1").Rows(i)
    Application.ScreenUpdating = False
    WorkRng.Select
    ActiveWorkbook.EnvelopeVisible = True
        With ActiveSheet.MailEnvelope
                .Introduction = "Text" + Worksheets("Sheet1").Cells(i, 3).Value 'append relevant info to text
                .Item.To = Worksheets("Sheet1").Cells(i, 1) 'cycling through each email
                .Item.Subject = "Subject"
                .Item.send
        End With
Application.ScreenUpdating = False
Next i
End Sub

Что я пробовал:

  1. Удаление определение диапазона. Это заставляет сценарий вернуться к присоединению всего листа.
  2. Установка диапазона для соответствующей информационной ячейки. Вся строка все еще добавляется в сообщение.
  3. Изменение ActiveSheet.MailEnvelope на ActiveCell.MailEnvelope. Компилируется нормально, но не отправляет электронные письма.

1 Ответ

0 голосов
/ 12 февраля 2020

Ниже я использую данные для отправки информации по электронной почте. Вы должны будете изменить его в соответствии с вашими потребностями. Он использует функцию для форматирования HTML в теле письма с некоторой информацией. Это может быть немного излишним для того, что вам нужно, но оно должно указывать вам правильное направление.

Эта подпрограмма генерирует и отправляет электронное письмо: 

Sub AppraisalReviewEmail()
    Dim OutlookApp As Object, MItem As Object
    Dim clsDate As Range, CustName As Range, PreSign As Range
    Dim strBody As String, CindyAppraisalEmail As String, hyperlink As String, currDir As String, Target As String, lNum As String

    Set clsDate = GeneralInfo.Range("genCloseDate")
    Set PreSign = SheetData.Range("Pre_Sign_Date")
    Set CustName = LoanData.Range("CustName1")

    Set OutlookApp = CreateObject("Outlook.Application")
    Set MItem = OutlookApp.CreateItem(0)

    lNum = GeneralInfo.Range("genLoanNumber")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    AppraisalEmail = redacted for public viewing
    currDir = MLAChecklist.path
    hyperlink = "<a href=""" & Replace(currDir, " ", "%20") & """>" & currDir & "</a>"

    Dim Subj As String, EmailAddr As String

    With MItem
        .To = AppraisalEmail
        .Subject = UCase("Appraisal Review" & " - " & CustName & " - " & lNum & " - " & "Closing Date " & clsDate)
        .Display
        .htmlbody = getAppraisalCheckListHTML(hyperlink, getAppraisalCheckListItems) & .htmlbody
        .Send
    End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Эти функции создают тело электронная почта с упорядоченным списком на основе элементов в указанной ячейке c: 

Option Explicit
Function getAppraisalCheckListItems() As String

    getAppraisalCheckListItems = "<li>" & Replace(SheetData.Range("Notes_for_Appraisal_Review").value, ",", "</li>" & vbNewLine & "<li>") & "</li>"

End Function
Function getAppraisalCheckListHTML(HyperlinkTag As String, CheckListItems As String) As String
    Const Delimiter As String = vbNewLine
    Dim list As Object
    Set list = CreateObject("System.Collections.ArrayList")

    Dim empName As String

    empName = "Roger Rabbit"

    If Len(SheetData.Range("Notes_for_Appraisal_Review")) = 0 Then
        With list
            .Add "<html>"
            .Add "<body style=font-size:11pt;font-family:Calibri>"
            .Add "Hello " & empName & ","
            .Add "<p>Please complete the appraisal review for the following file:"
            .Add "&nbsp&nbsp"
            .Add HyperlinkTag
            .Add "<br><br>"
            .Add "Thank You,"
            .Add "</p>"
            .Add "</body>"
            .Add "</html>"
        End With
    Else
        With list
            .Add "<html>"
            .Add "<body style=font-size:11pt;font-family:Calibri>"
            .Add "Hello " & empName & ","
            .Add "<p>Please complete the appraisal review for the following file:"
            .Add "&nbsp&nbsp"
            .Add HyperlinkTag
            .Add "<br><br>"
            .Add "Items to make note of in the file."
            .Add "<ol>"
            .Add Trim(CheckListItems)
            .Add "</ol>"
            .Add "<br>"
            .Add "Thank You,"
            .Add "</p>"
            .Add "</body>"
            .Add "</html>"
        End With
    End If

    getAppraisalCheckListHTML = Join(list.ToArray, Delimiter)

End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...