Sub email()
Dim data As String
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Set rngZiel = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
data = rngZiel.Text
Dim dataa() As String
dataa = Split(data)
Dim kostenstelle As String
Dim empf, empf2 As String
kostenstelle = dataa(2)
empf = dataa(0)
empf2 = dataa(1)
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Dim pfad As String
pfad = ActiveDocument.FullName
Dim name1a() As String
name1a = Split(pfad, ".docx")
pfad = name1a(0)
ActiveDocument.ExportAsFixedFormat pfad + ".pdf", 17
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.Recipients.Add empf
.Recipients.Add empf2
.Subject = "Auftrag Bipa Filiale " & kostenstelle
.Body = "Sehr geehrte Damen und Herren," + vbCrLf + vbCrLf + "anbei Ihr Auftrag zu o.g. Projekt. Bitte möglichst umgehend um Signatur und Weiterleitung an Bipa:" + vbCrLf + "Die ausführende Firma unterschreibt, wenn möglich digital, die Beauftragung und sendet diese per E-Mail an BIPA. Ist eine digitale Signatur nicht möglich wird das Dokument nur einmal ausgedruckt, unterfertigt, eingescannt und dann elektronisch an BIPA (z.H. Frau Sabine Pirkfellner - s.pirkfellner@bipa.co.at <mailto:s.pirkfellner@bipa.co.at>) verschickt. Dies MUSS bis spätestens eine Woche vor Baubeginn der Fall sein. Es ist darauf zu achten, dass die Scans eine hochwertige Qualität aufweisen und gut lesbar sind." + vbCrLf + vbCrLf + "Mit freundlichen Grüßen" + vbCrLf + vbCrLf + "READIT" + vbCrLf + "LIMITarchitects" + vbCrLf + "wollzeile 17 / a 1010 vienna" + vbCrLf + "limit.at / t +43 (0)1 5133007 / f +43 (0)1 5133008" + vbCrLf + "limit@limit.at"
.ReadReceiptRequested = False
.Attachments.Add pfad + ".pdf"
.Display
.Send
End With
Set olApp = Nothing
ActiveDocument.Save
ActiveDocument.Close
End Sub