Как сохранить содержимое любой ячейки вместе с форматированием в строковой переменной, чтобы я мог отправить его как вложение тела в vba? - PullRequest
0 голосов
/ 05 июля 2019

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

Я пытался использоватьСвойства .text и .copy с select и range (Cell), но это не работает.Я также пытался использовать свойство htmlBody, но управление тегами html в ячейку, например, выделенную жирным шрифтом <\ b>, неосуществимо и достаточно просто для простого пользователя.

Function FileExists(FilePath As String) As Boolean
Dim TestStr As String
    TestStr = ""
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0
    If TestStr = "" Then
        FileExists = False
    Else
        FileExists = True
    End If
End Function

Sub MAIL()

    Dim i As Long
    i = 2
    MsgBox "Let's Start Now"
    Dim answer As Integer
    Dim a1 As Integer

    Range("A2").Activate

    Do While True

        Dim outlookApp As Outlook.Application
        Dim myMail As Outlook.MailItem
        Set outlookApp = New Outlook.Application
        Set myMail = outlookApp.CreateItem(olMailItem)

        If IsEmpty(ActiveCell) Then Exit Do

        MsgBox "Emailing To" & vbNewLine & ActiveCell.Value

        myMail.To = ActiveCell
            ActiveCell.Offset(0, 1).Select
        myMail.CC = ActiveCell

        ActiveCell.Offset(0, 1).Select

        myMail.Body = ActiveCell.Text

        MsgBox ActiveCell
            ActiveCell.Offset(0, 1).Select

        myMail.Subject = ActiveCell
            ActiveCell.Offset(0, 1).Select 

        Dim sofi As String
        sofi = "A:\Documents\Mail Attachments\" & ActiveCell & ".pdf"
        If Not (IsEmpty(ActiveCell)) Then
            If FileExists(sofi) Then
                myMail.Attachments.Add sofi
                myMail.Send
            Else
                answer = MsgBox("Do you want to attach this file externally ?", vbYesNo + vbQuestion, ActiveCell & ".pdf | " & Range("A" & i).Value & "- Not Found")
                If answer = vbYes Then
                    Source_File = Application.GetOpenFilename
                    myMail.Attachments.Add Source_File
                Else
                    a1 = MsgBox("You can still send the mail, without this attachments?", vbYesNo + vbQuestion, "Send Mail")
                    If a1 = vbYes Then
                        myMail.Send
                    Else
                        'do nothing
                    End If
                End If
            End If
        End If

        MsgBox "Delivered to" & Range("A" & i).Value
        myMail.Display    

        i = i + 1
        Range("A" & i).Activate

    Loop

End Sub
...