Im VBA Zeilen ausblenden
24.03.2020 13:25:20
Torsten
Aus dem VBA heraus wird eine Email erzeugt in der ich mehrere Zellen Text anzeigen lasse
Ich habe im Tabellenblatt ein Formularsteuerelement (Haken im Feld C1
Wenn ich dies aktiviere, dann fügt es 5 weitere Zeilen text hinzu, die vorher durch folgende Methode ausgeblendet sind.
=WENN($C$1=WAHR;"Die Ware muss nach oben hin entladbar sein.";"")
Mein Problem beim erstellen der Mail ist die, dass die Mail bei ausgeblendeten Text trotzdem die 5 leeren Zeilen erstellt. B16-B20
Damit habe ich aber einen zu großen Abstand zwischen der Mail und der Signatur.
Wie kann ich das anders lösen? Hinter .value & steht überall noch ein
Sub senden()
Dim olApp As Object
Dim str_signatur_pfad As String
str_signatur_name = "Auto-Signatur-extern"
str_signatur_pfad = Environ("appdata") & "\Microsoft\Signatures\" & str_signatur_name & ".htm"
If Dir(str_signatur_pfad) "" Then
str_signatur = GetSignature(str_signatur_pfad)
Else
str_signatur = "Bitte Signatur wie folgt umbenennen: Auto-Signatur-extern"
End If
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
strhtml = strhtml & ""
strhtml = strhtml & Range("B7").Value & "
strhtml = strhtml & Range("B8").Value & "
strhtml = strhtml & Range("B9").Value & "
strhtml = strhtml & Range("B10").Value & "
strhtml = strhtml & Range("B11").Value & "
strhtml = strhtml & Range("B12").Value & "
strhtml = strhtml & Range("B13").Value & "
strhtml = strhtml & Range("B14").Value & "
strhtml = strhtml & Range("B15").Value & "
strhtml = strhtml & Range("B16").Value & "
strhtml = strhtml & Range("B17").Value & "
strhtml = strhtml & Range("B18").Value & "
strhtml = strhtml & Range("B19").Value & "
strhtml = strhtml & Range("B20").Value & "
"
strhtml = strhtml & "" & str_signatur
.SentOnBehalfOfName = Range("B3")
.To = Range("B4")
.cc = Range("B5")
.bcc = Range("B6")
.Subject = Range("B2")
.htmlbody = strhtml
.Display
Dim strAttachment As String, strxlFile As String, strPDFFile As String
Dim objxl As Object, objxlFile As Object
Dim Mappe As String
Mappe = ThisWorkbook.Path & "\" & "Transportauftrag.xlsx"
Workbooks.Open Filename:=Mappe, UpdateLinks:=3
ActiveWorkbook.Close SaveChanges:=True
strxlFile = ThisWorkbook.Path & "\" & "Transportauftrag.xlsx"
strPDFFile = Left(strxlFile, InStrRev(strxlFile, ".") - 1) & ".pdf"
Set objxl = CreateObject("excel.Application")
Set objxlFile = objxl.Workbooks.Open(strxlFile)
objxlFile.ExportAsFixedFormat xlTypePDF, strPDFFile
objxlFile.Close False
objxl.Quit
.Attachments.Add strPDFFile
Set objxlFile = Nothing
Set objxl = Nothing
End With
Set olApp = Nothing
End Sub
Function GetSignature(fPath As String) As String
Dim fso As Object
Dim TSet As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set TSet = fso.getfile(fPath).OpenAsTextStream(1, -2)
GetSignature = TSet.readall
TSet.Close
End Function