|
Hallo,
aus deiner Anschriftenzeile deiner Textvorlage den Platzhalter für Vorname bitte löschen.
Anschriftenzeile dann bitte so:
Sehr geehrt[@Anrede] [@Name],
Code:
Option Explicit
Public Sub Mail_Text()
Dim strVorlage As String, strText As String
Dim loLetzte As Long, i As Long, raFund As Range
strVorlage = Worksheets("_Text").Shapes.Range(Array("TextBox 1")).TextFrame2.TextRange.Characters.Text
With Worksheets("Email")
Set raFund = .Columns(3).Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, _
searchdirection:=xlPrevious)
If Not raFund Is Nothing Then
loLetzte = raFund.Row
End If
For i = 9 To loLetzte
If .Cells(i, 6) <> "" Then
strText = strVorlage
strText = Replace(strText, "[@Anrede]", WorksheetFunction.Trim(.Cells(i, 9)), , , vbTextCompare)
strText = Replace(strText, "[@Name]", WorksheetFunction.Trim(.Cells(i, 7)) _
& " " & WorksheetFunction.Trim(.Cells(i, 6)), , , vbTextCompare)
strText = Replace(strText, "[@Alter]", WorksheetFunction.Trim(.Cells(i, 8)) & ".", , , vbTextCompare)
Else
strText = strVorlage
strText = Replace(strText, "[@Anrede]", WorksheetFunction.Trim(.Cells(i, 9)), , , vbTextCompare)
strText = Replace(strText, "[@Name]", "")
strText = Replace(strText, "[@Alter]", WorksheetFunction.Trim(.Cells(i, 8)) & ".", , , vbTextCompare)
End If
'Ausgabe in MessageBox zum Testen
MsgBox strText
Next
End With
Set raFund = Nothing
End Sub
Gruß Werner
|