01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34 |
|
Private Sub Mail_Versand()
' Sendet Mail mit integriertem Bereich als Bereich mit Signatur
Dim WSh As Worksheet
Dim sMailtext As String, sBer As String, sArr() As String
Dim i As Integer
Set WSh = ThisWorkbook.Sheets("Template") ' Blatt mit Maildaten
Select Case WSh.Range("C10").Value
Case "Kaffee-Date": sBer = "B12:D21"
Case "Erstes-Interview": sBer = "B23:D23,B26:D33"
Case Else: Exit Sub
End Select
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2 ' 2=HTML-Format, 3=Richtext
.Subject = WSh.Range("C10").Value _
& " / Bitte um weitere Bearbeitung" ' Betreff
.To = "xxx" ' Empfänger
.CC = "" ' Kopie
sMailtext = "Hallo Otto,¶¶dieses bitte bearbeiten!¶¶"
.GetInspector.Display ' Signatur holen
.htmlbody = Replace(sMailtext, "¶", "<br>") & .htmlbody
sArr = Split(sBer, ",")
For i = UBound(sArr) To 0 Step -1
WSh.Range(sArr(i)).Copy ' Bereich kopieren
With .GetInspector.WordEditor.Application.Selection
.Start = Len(sMailtext) - 1 ' Hier mit der Positionierung ggf. spielen
.Paste ' Bereich in Mail einfügen
End With
Next i
End With
End Sub
|