Тело проблемы макроса электронной почты - PullRequest
0 голосов
/ 24 сентября 2019

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

Как мне идеально выбрать диапазон ячеек в качестве тела письма для отправки?

Sub Mail_Selection_Range_Outlook_Body()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Sheet1")
    Dim i As Integer
    Dim last_row As Integer

    last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))


    Set rng = Nothing
    On Error Resume Next

    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'Set rng = Sheets("Sheet1").Range("A10:L40").SpecialCells(xlCellTypeVisible)

    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With


    On Error Resume Next

    For i = 2 To last_row
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .to = sh.Range("A" & i).Value
        .cc = sh.Range("E" & i).Value
        .BCC = ""
        .Subject = sh.Range("B" & i).Value
    If sh.Range("C" & i).Value <> "" Then
        .attachments.Add sh.Range("C" & i).Value
    End If

    If sh.Range("D" & i).Value <> "" Then
        .attachments.Add sh.Range("C" & i).Value
    End If

        .HTMLBody = RangetoHTML(rng)
        .Send

    End With
    Next i

    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Использована отдельная функция "RangetoHTML(rng As Range)".

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