Sub MailTempDoc()
 
    Dim DocName As String
    Dim MailDot As String
 
    If Documents.Count = 0 Then Exit Sub
    If ActiveDocument.Type = wdTypeTemplate Then
        Call MsgBox("Eine Vorlage kann nicht als Email versandt werden.", _
            vbExclamation, "VORBEREITUNG FEHLGESCHLAGEN!")
        Exit Sub
    End If
 
    'Überprüfung, ob letzte Änderungen gespeichert wurden
    If ActiveDocument.Saved = False Then
        Call MsgBox("Bitte speichern Sie zuerst die letzten Änderungen " & _
            "in Ihrem Dokument und" & Chr(13) & "starten Sie danach das Makro" & _
            "erneut!", _
            vbInformation, "ÄNDERUNGEN SPEICHERN!")
        Exit Sub
    End If
 
    ' Mail.dot Global geladen?
    For Each dot In Templates
        If UCase(dot.Name) = TXT_MAIL_DOT Then
            MailDot = dot.FullName
            Exit For
        End If
    Next dot
 
    ' wenn nicht geladen, dann abbrechen
    If (MailDot = "") Then
        Call MsgBox("Die Dokumentenvorlage '" & TXT_MAIL_DOT & "' konnte nicht" & _
          "gefunden werden.", _
            vbExclamation, "VORLAGE NICHT GEFUNDEN!")
        Exit Sub
    End If
 
    ' benötigte Pfade überprüfen
    If Dir("C:\Temp", vbDirectory) = "" Then MkDir ("C:\Temp")
    If Dir(TempMailPfad, vbDirectory) = "" Then MkDir (TempMailPfad)
    If Dir(TempDocPfad, vbDirectory) = "" Then MkDir (TempDocPfad)
 
    ' Name des Activen Documentes merken und in TempDocPfad speichern
    DocName = ActiveDocument.Name
    DocTempName = TempDocPfad & DocName
 
    ActiveDocument.SaveAs FileName:=DocTempName, FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        False, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
 
    DocNamePfad = ActiveDocument.FullName
    DocTempName = TempMailPfad & "MAIL_" & DocName
    ActiveDocument.Close
 
    ' Neues Dokument von Mail.dot erstellen
    Documents.Add (MailDot)
    Call Selection.InsertFile(FileName:=DocNamePfad, Range:="", _
        ConfirmConversions:=False, Link:=False, Attachment:=False)
 
    ' Letzte Absatzmarke löschen
    Selection.EndKey Unit:=wdStory
    Selection.TypeBackspace
    Selection.HomeKey Unit:=wdStory
 
    ' Normal.Dot zuweisen
    ActiveDocument.AttachedTemplate = NormalTemplate
 
    ' Neues Dokument als Temp-Datei abspeichern
    ActiveDocument.SaveAs FileName:=DocTempName, FileFormat:=wdFormatDocument, _
      AddToRecentFiles:=False
 
    ' Datei in TempDocPfad löschen
    Kill (TempDocPfad & DocName)
 
 
    ' Symbol Mailsend aktivieren
    For Each Symbolleiste In Application.CommandBars
    If Symbolleiste.Name = "Standard" Then
        Set stLeiste = Application.CommandBars(Symbolleiste.Index)
        Exit For
    End If
    Next Symbolleiste
    For Each Symbol In stLeiste.Controls
        If Symbol.Caption = "MailSend" Then stLeiste.Controls( _
          "MailSend").Enabled = True
    Next Symbol
 
End Sub

-----------------
MfG GeiseL