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
MsgBox strText
Next
End
With
Set
raFund =
Nothing
End
Sub