Получение условного форматирования в HTMLBody - PullRequest
Новая
       8

Получение условного форматирования в HTMLBody

0 голосов
/ 14 сентября 2018

Есть ли возможность иметь тело HTML:

.HTMLBody = strText & RangetoHTML(rng) & "<br><br>" & GetBoiler(Environ("appdata") & "\Microsoft\Signatures\" & strFilename & ".htm")

... при выполнении criteria > 1 и ...

.HTMLBody = strText2 & "<br><br>" & GetBoiler(Environ("appdata") & "\Microsoft\Signatures\" & strFilename & ".htm")

'в этом случае диапазон отсутствует, и текст выполняется при выполнении criteria = 0.

Я думал о функции «if» в теле HTML?

Функция GetBoiler: 

Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object, ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

Функция диапазона: 

Function RangetoHTML(rng As Range)
    Dim fso As Object, ts As Object, TempWB As Workbook
    With Worksheets("Auswertung")
        loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("$A$7:$D$" & loLetzte).AutoFilter Field:=3, Criteria1:=">0"
        If .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
            .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1). _
                    SpecialCells(xlCellTypeVisible).Copy
        Else
            'copy only the strText2
        End If
        .AutoFilterMode = False
    End With
End Function

Основная подфункция: 

Sub Mail_Klicken()
    Dim olApp As Object, datDatum As Date, StrBody As String, intZeile As Integer
    Dim OutMail As Object, rng As Range, strMailverteilerTo As String
    Dim strText As String, strFilename As String, loLetzte As Long
    strMailverteilerTo = "sdfgsdf@gmx.de"
    strText = "<span style='font-size:10.0pt;font-family:""Arial"",""sans" & _
        "-serif"";color:black'>hello,<br><br>hello fellows.<br><br>"
    strText2 = "<span style='font-size:10.0pt;font-family:""Arial"",""sans" & _
        "-serif"";color:black'>dfgfg,<br><br>gfgfgfgfg.<br><br>"
    Application.DisplayAlerts = True
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    Set olApp = CreateObject("Outlook.Application")
    With olApp.CreateItem(0)
        .to = strMailverteilerTo
        .Subject = "check"
        strFilename = "Standard"
        If Application.UserName = "asd" Then strFilename = "asd"
        .HTMLBody = strText & RangetoHTML(rng) & "<br><br>" & _
            GetBoiler(Environ("appdata") & "\Microsoft\Signatures\" & _
            strFilename & ".htm")
        .Display
    End With
    Set olApp = Nothing
End Sub

1 Ответ

0 голосов
/ 14 сентября 2018

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

Set olApp = CreateObject("Outlook.Application")
setStrText criteria, strText, rng 
With olApp.CreateItem(0)
'rest of your code
    .HTMLBody = strText
'rest of your code

function setStrText(crit as integer, strTe as string, tmpRng as range)
    if crit >= 1 then
        strTe = "<span style='font-size:10.0pt;font-family:""Arial"",""sans" & "-serif"";color:black'>hello,<br><br>hello fellows.<br><br>" & RangetoHTML(tmpRng) & "<br><br>" & GetBoiler(Environ("appdata") & "\Microsoft\Signatures\" & strFilename & ".htm")
    else
        strTe = "<span style='font-size:10.0pt;font-family:""Arial"",""sans" & "-serif"";color:black'>dfgfg,<br><br>gfgfgfgfg.<br><br>" & "<br><br>" & GetBoiler(Environ("appdata") & "\Microsoft\Signatures\" & strFilename & ".htm")
    end if
end function
...