根据 outlook 中的某些条件粘贴值

Question

根据标准 "copy the filtered ranges" 应将 "strText" 中所述的文本粘贴到电子邮件中，两者均为 html。如果条件未完整填写，则仅采用 "strText2" 中所述的文本并将其粘贴到电子邮件中。

问题是只有 "strText" 中的文本被复制到电子邮件中，而没有复制范围。其次，在 "Else" 行中，代码“.HTMLBody = strText2”不会直接转到 sheet。

（为简单起见，"Function GetBoiler..." 已被排除）

Sub Mail_Klicken()

Dim olApp As Object

Dim datDatum As Date
Dim StrBody As String
Dim intZeile As Integer
Dim rng As Range

Dim strMailverteilerTo As String
Dim strMailverteilerCC As String
Dim strText As String
Dim strFilename As String
Dim loLetzte As Long

strMailverteilerTo = "dfgdfg@gmx.de


   strText = "<span style='font-size:10.0pt;font-family:""Arial"",""sans-serif"";color:black'>Hello,<br><br> xxxx:<br><br>"

  strText2 = "<span style='font-size:10.0pt;font-family:""Arial"",""sans-serif"";color:black'>hello,<br><br>this is the second text.<br><br>"

 Application.DisplayAlerts = True

 Set olApp = CreateObject("Outlook.Application")

 With olApp.CreateItem(0)

    .to = strMailverteilerTo
    .Subject = "asdf checked"

    strFilename = "Standard"
    If Application.UserName = "wert" Then strFilename = "Signatur allg.1"

    strText = strText & "" & GetBoiler(Environ("appdata")       & "\Microsoft\Signatures\" & strFilename & ".htm")


 With Worksheets("Auswertung")
   loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
   .Range("$A:$D$" & loLetzte).AutoFilter Field:=4, 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
    'take only the "strText2"
End If
   .AutoFilterMode = False
End With

.HTMLBody = strText
.Display

End With

Set olApp = Nothing

End Sub

Answer 1

答案可以在这里找到：https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

根据 outlook 中的某些条件粘贴值

Paste a value according to some criteria in outlook

email

excel

vba

criteria

paste