HTML Outlook Tabelle

[00202]

Problem dabei ist auch das ich eben keine feste Range in der Mail will sondern eben nur die einer Zeile zugehörigen Informationen wenn die Datumsbedingung erfüllt ist.

Hallo Leonhard, :19:

deshalb schrieb ich auch, dass es einfacher ist, wenn du die Daten der Zellen die zutreffen erst mal "sammelst" und dann an die Funktion übergibst.
Da ich jetzt auf Achse bin, kann ich dir erst Morgen Vormittag ein Beispiel posten. :21:

[schauan]

Hallo Leo,

also, der Code funktioniert erst mal. Zum Daten sammeln sag ich nichts, nur zu der html-Geschichte.
Kennst Du die HTML-Tags für eine Tabelle (z.B. table, tr und th)?

Die einfachste Variante um überhaupt erst mal eine Tabelle zu bekommen, wäre am Anfang vom htmlbody damit zu beginnen

PHP-Code:

.htmlbody = "<table><tr><th>Guten Tag,<br><br>" & _ 


und am Ende vom htmlbody damit aufzuhören

PHP-Code:

                "<b><br>m?-Preis:</b> " & Tabelle1.Cells(rngCell.Row, 6).Value & strOldBody & "</th></tr></table>" 


Da ist dann erst mal der gesamte Text in einer "Zelle".

[00202]

Hallo Leonhard, :19:

nachfolgend mal das Beispiel mit "Daten sammeln": :21:
[attachment=21939]

Oder du greifst - wie ich in #5 schon schrieb - auf HTML zurück (und baust das mit den entsprechenden Befehlen im ".htmlbody =" auf - je nachdem, was dir mehr liegt. :21:

Wenn der Bereich "Q1:T4" bei dir schon belegt ist, dann nimm einfach einen anderen. Oder ein anderes Tabellenblatt (welches du auch temporär per VBA erzeugen und am Schluss wieder löschen kannst). :21:

Ich denke mit dem Beispiel von mir sollte das lösbar sein.

[Leonhard]

Hallo zusammen,

ich bin leider immer noch nicht dazu gekommen mir das anzuschauen.
Aber schon vorab vielen lieben Dank für eure Hilfe!!

Beste Grüße
Leo

[Leonhard]

Hi case,

funktioniert einwandfrei. Vielen lieben Dank.
Nur für die Optik: Kann man die Tabelle auch linksbündig und mit Rahmen formatieren?

Beste Grüße
Leo

[Klaus-Dieter]

Hallo,

ohne das jetzt gesehen zu haben, ja.

[Leonhard]

Hallo zusammen,

ich dachte ich bin ein Fuchs und formatiere einfach den Bereich der zum "sammeln" festgelegt worden ist :05:
Klappt allerdings nur bedingt gut :20:


   

Was mache ich da falsch?

[00202]

Was mache ich da falsch?

Hallo Leonhard, :19:

nun - wahrscheinlich formatierst du die falschen Zellen? :21:
Ich würde das auch nicht vorher machen, sondern direkt im Code. Brauchst du da ein Beispiel? Probiere mal etwas mit dem Makrorekorder, da siehst du schon wie die Befehle heißen, um z. B. Rahmen zu setzen, bzw. zu entfernen.

[Leonhard]

Code:

Private Sub Workbook_Open()
   Dim strOldBody As String
   Dim objOutApp As Object
   Dim rngBereich As Range
   Dim lngRow As Integer
   Dim rngDatum As Range
   Dim rngCell As Range
   On Error GoTo Fin
   With Tabelle1
       lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row
       Set rngDatum = .Range("A2:A" & lngRow)
       For Each rngCell In rngDatum
           If IsDate(rngCell) Then
If rngCell.Value <= DateAdd("m", 24, Date) And rngCell.Offset(0, 8).Value >= 2000 And rngCell.Offset(0, 3).Value = "" Then
                   .Range("Q1").Value = "Anschrift:"
                   .Range("R1").Value = .Cells(rngCell.Row, 7).Text & " ;" & .Cells(rngCell.Row, 6).Text & " ;" & .Cells(rngCell.Row, 8).Text
                   .Range("Q2").Value = "NF 2:"
                   .Range("R2").Value = .Cells(rngCell.Row, 9).Text
                   .Range("Q3").Value = "Miete (Netto):"
                   .Range("R3").Value = .Cells(rngCell.Row, 10).Text
                   .Range("Q4").Value = "qm-Preis:"
                   .Range("R4").Value = .Cells(rngCell.Row, 5).Text
                   Set rngBereich = Range("Q1:R4")
  Range("Q1:R4").Select
   With Selection.Borders(xlEdgeLeft)
       .LineStyle = xlContinuous
       .ColorIndex = 0
       .TintAndShade = 0
       .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeTop)
       .LineStyle = xlContinuous
       .ColorIndex = 0
       .TintAndShade = 0
       .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeBottom)
       .LineStyle = xlContinuous
       .ColorIndex = 0
       .TintAndShade = 0
       .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeRight)
       .LineStyle = xlContinuous
       .ColorIndex = 0
       .TintAndShade = 0
       .Weight = xlThin
   End With
   With Selection.Borders(xlInsideVertical)
       .LineStyle = xlContinuous
       .ColorIndex = 0
       .TintAndShade = 0
       .Weight = xlThin
   End With
   With Selection.Borders(xlInsideHorizontal)
       .LineStyle = xlContinuous
       .ColorIndex = 0
       .TintAndShade = 0
       .Weight = xlThin
   End With
                   .Columns("Q:R").AutoFit
                   Set objOutApp = CreateObject("Outlook.Application").CreateItem(0)
                   With objOutApp
                       .GetInspector.Display
                       strOldBody = .HtmlBody
                       .To = Tabelle1.Cells(rngCell.Row, 2).Value
                       .Subject = "Kundenakquise - " & Tabelle1.Cells(rngCell.Row, 3).Value
                       .HtmlBody = "Guten Tag,<br><br>" & _
                          "dies ist eine automatische Erinnerung " & _
                          "sich bei dem Kunden<b> " & Tabelle1.Cells(rngCell.Row, 3).Value & _
                          " </b>zu melden, da dessen Mietvertrag in weniger als 24 Monaten" & " <b>(" & "" & Tabelle1.Cells(rngCell.Row, 1).Value & ")</b>" & " ausläuft.<br>" & _
                          "Sollte der Mieter sein Optionsrecht wahrnehmen, ändern Sie das Fälligkeitsdatum bitte auf das durch die Optionsziehung angepasste Datum." & _
                          " Nachfolgend alle Mietdetails:<br><br>" & RangetoHTML(rngBereich) & "<br><br>" & strOldBody
                       .Display
                       '.Send ' Sofort senden
                   End With
                   .Cells(rngCell.Row, 4).Value = Now
                   rngBereich.ClearContents
               End If
                                       
             End If
           
           Next rngCell
           
   End With
Fin:
   Set rngBereich = Nothing
   Set objOutApp = Nothing
   If Err.Number <> 0 Then MsgBox "Fehler: " & _
       Err.Number & " " & Err.Description

Range("P8").Select
    Selection.Copy
    Range("Q1:R4").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

Hallo Case, 

ich habe das jetzt über den Makro Recorder probiert
habe die Range auch auf Q1:R4 gesetzt aber die Rahmen werden mir (in der Mail) für 4 Spalten und 2 Zeilen gesetzt.. Waarum :22:
Zum Ende hin entferne ich dann wieder die Rahmenlinien, was bestimmt auch eleganter geht


Beste Grüße und kurz davor es einfach ohne Rahmen zu formatieren,
Leo

[00202]

Hallo Leonhard, :19:

Elegant? Das muss nur laufen - der Rest ist Nebensache. :21:
[attachment=22232]