Registriert seit: 30.08.2014
Version(en): Office 365 - Beta 32 Bit
(17.01.2019, 11:19)Leonhard schrieb: 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:
________
Servus
Case
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
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".
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:1 Nutzer sagt Danke an schauan für diesen Beitrag 28
• Leonhard
Registriert seit: 30.08.2014
Version(en): Office 365 - Beta 32 Bit
Hallo Leonhard, :19:
nachfolgend mal das Beispiel mit " Daten sammeln": :21:
Outlook_Mail_automatisch_einmal_versenden_nach_Datum_Tabelle.xlsb (Größe: 25,96 KB / Downloads: 8)
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.
________
Servus
Case
Folgende(r) 1 Nutzer sagt Danke an Case für diesen Beitrag:1 Nutzer sagt Danke an Case für diesen Beitrag 28
• Leonhard
Registriert seit: 17.05.2018
Version(en): 365
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
Registriert seit: 17.05.2018
Version(en): 365
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
Registriert seit: 11.04.2014
Version(en): Office 365
Hallo,
ohne das jetzt gesehen zu haben, ja.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter,
der Misserfolg ist ein Waisenkind
Richard Cobden
Registriert seit: 17.05.2018
Version(en): 365
25.01.2019, 14:14
(Dieser Beitrag wurde zuletzt bearbeitet: 25.01.2019, 14:15 von 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?
Registriert seit: 30.08.2014
Version(en): Office 365 - Beta 32 Bit
(25.01.2019, 14:14)Leonhard schrieb: 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.
________
Servus
Case
Registriert seit: 17.05.2018
Version(en): 365
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
Registriert seit: 30.08.2014
Version(en): Office 365 - Beta 32 Bit
Hallo Leonhard, :19:
Elegant? Das muss nur laufen - der Rest ist Nebensache. :21:
Outlook_Mail_automatisch_einmal_versenden_nach_Datum_Tabelle_Rahmen.xlsb (Größe: 28,93 KB / Downloads: 5)
________
Servus
Case
Folgende(r) 1 Nutzer sagt Danke an Case für diesen Beitrag:1 Nutzer sagt Danke an Case für diesen Beitrag 28
• Leonhard
|