Hallo Hr. Huber,
meines Wissens kann das DATEV nicht, obwohl es auch kein Problem wäre.
In einem ähnlichen Fall löse ich so etwas über ein eigenes Makro direkt in Outlook.
Dazu gehe ich wie folgt vor:
[Ziel]
Es soll immer für einen Mandanten die FiBu-Auswertungen als Einzeldateien per Mail versendet werden. Im Mailtext möchte ich zusätzlich eine persönliche Anrede und die zu fällige USt. mitteilen.
[Vorgehensweise]
- Es werden alle Ausdrucke einzeln in eine festes Verzeichnis exportiert.
- Ich öffne OL und erstelle eine neue Mail.
[Formular]
Die Mailadressen sind in einer INI gespeichert und wird beim Start des Formulars ausgelesen. Nach dem Klicken des Button "Mail erstellen" wird in der offenen Mail der Standardtext und die Anlagen eingefügt.
[Code]
Private Sub cmdMail_Click()
Dim objItem As MailItem
Dim sTex As String
Dim fso As New FileSystemObject
Dim objShell As New WshShell
Dim a As Object
Dim strMailFile As String
10 On Error GoTo cmdMail_Click_Error
20 Dim sTB As String: sTB = GetIniString("Autotext", "FiBu", "", sFileINI)
30 If sTB = "" Then
40 Call MsgBox("Es wurde der Autotext-Name für die FiBu-Mail noch nicht in der INI gespeichert." _
& vbCrLf & "" _
& vbCrLf & "Bitte tragen Sie erst unter der Rubrik [Autotext] den Autotextnamen ein." _
& vbCrLf & " [Autotext]" _
& vbCrLf & " FiBu=..." _
, vbExclamation, "Autotext FiBu-Mail")
50 Exit Sub
60 End If
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
Dim myAT As AutoTextEntry
'On Error Resume Next
70 Set objItem = Application.ActiveInspector.CurrentItem
80 objItem.BodyFormat = olFormatHTML 'immer HTML
90 If Not objItem Is Nothing Then
100 If objItem.Class = olMail Then
110 Set objInsp = objItem.GetInspector
120 If objInsp.EditorType = olEditorWord Then
130 Set objDoc = objInsp.WordEditor
140 Set objWord = objDoc.Application
150 Set objSel = objWord.Selection
'170 objWord.ScreenUpdating = False
160 For Each myAT In objDoc.AttachedTemplate.AutoTextEntries
170 If (myAT.Name = sTB) Then Exit For
180 Next
190 myAT.Insert objSel.Range, True
200 With objDoc.Content.Find
210 .Text = "<Anrede>"
220 .Replacement.Text = sAnrede
230 .Forward = True
240 .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
250 End With
260 With objDoc.Content.Find
270 .Text = "<FiBu>"
280 .Replacement.Text = txtFiBu_Zeitraum.Text
290 .Forward = True
300 .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
310 End With
320 With objDoc.Content.Find
330 .Text = "<Firma>"
340 .Replacement.Text = cmbEmpfänger.Text
350 .Forward = True
360 .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
370 End With
Dim sSchlusssatz As String
Dim cSumme As Currency
380 cSumme = (CCur("0" & txtSVZ.Text) + CCur("0" & txtZahllast.Text))
390 If cSumme > 0 Then
400 If chkEinzug.Value = True Then
410 sSchlusssatz = "Die Steuerzahlungen werden zum " & dFällig & " vom Finanzamt abgebucht."
420 Else
430 sSchlusssatz = "Bitte überweisen die Steuerzahlungen bis zum " & dFällig & "."
440 End If
450 Else
460 sSchlusssatz = "Das Guthaben wird Ihnen erstattet."
470 End If
480 With objDoc.Content.Find
490 .Text = "<Zahlungsart>"
500 .Replacement.Text = sSchlusssatz
510 .Forward = True
520 .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
530 End With
Dim c As Cell
Dim aTbl As Word.Table
540 Set aTbl = objDoc.Tables.Item(1)
550 On Error Resume Next
560 With aTbl
570 .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
580 .Borders(wdBorderRight).LineStyle = wdLineStyleNone
590 .Borders(wdBorderTop).LineStyle = wdLineStyleNone
600 .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
610 .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
620 .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
630 .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
640 .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
650 .Borders.Shadow = False
.PreferredWidth = objWord.CentimetersToPoints(9)
.Columns(1).PreferredWidthType = wdPreferredWidthPoints
660 .Columns(1).Width = objWord.CentimetersToPoints(3)
.Columns(2).PreferredWidthType = wdPreferredWidthPoints
670 .Columns(2).Width = objWord.CentimetersToPoints(3)
.Columns(3).PreferredWidthType = wdPreferredWidthPoints
680 .Columns(3).Width = objWord.CentimetersToPoints(3)
690 End With
700 On Error GoTo cmdMail_Click_Error
710 With aTbl
720 Set c = .Cell(2, 1)
730 c.Range.InsertAfter "USt.-VA"
740 Set c = .Cell(2, 2)
750 c.Range.InsertAfter txtUStVA_Zeitraum.Text
760 c.Select
770 objSel.ParagraphFormat.Alignment = wdAlignParagraphRight
780 Set c = .Cell(2, 3)
790 c.Range.InsertAfter txtZahllast.Text
800 c.Select
810 objSel.ParagraphFormat.Alignment = wdAlignParagraphRight
820 If txtSVZ.Enabled = False Then
830 .Rows(.Rows.Count).Delete
840 .Rows(.Rows.Count).Delete
850 Else
'SVZ Ja
860 Set c = .Cell(3, 1)
870 c.Range.InsertAfter "USt.-SVZ"
880 Set c = .Cell(3, 2)
890 c.Range.InsertAfter Year(CDate(txtUStVA_Zeitraum.Text)) + 1
900 c.Select
910 objSel.ParagraphFormat.Alignment = wdAlignParagraphRight
920 Set c = .Cell(3, 3)
930 c.Range.InsertAfter txtSVZ.Text
940 c.Select
950 objSel.ParagraphFormat.Alignment = wdAlignParagraphRight
'Summe SVZ
960 Set c = .Cell(4, 3)
970 c.Range.InsertAfter Format(cSumme, "#,##.0,00")
980 c.Select
990 With objSel
1000 .ParagraphFormat.Alignment = wdAlignParagraphRight
1010 .Font.Bold = True
1020 .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
1030 .Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
1040 End With
1050 End If
1060 End With
1070 objDoc.Select
1080 With objSel
1090 .Font.Name = "Calibri"
1100 .Font.Size = 11
1110 End With
1120 Set objSel = Nothing
1130 With objWord
1140 .Selection.EndKey wdStory
1150 .Selection.Collapse
1160 End With
Dim colFile As New Collection
1170 Set colFile = FindFiles(sExportPfad, "*" & cmbEmpfänger.List(cmbEmpfänger.ListIndex, 0) & "*.*", False, vbNormal)
1180 With objItem
1190 .To = sMailEmpfänger
1200 .Subject = "FiBu-Auswertung für " & txtFiBu_Zeitraum.Text
1210 For i = 1 To colFile.Count
1220 .Attachments.Add colFile(i)
1230 fDelete colFile(i), True, False
1240 Next
1250 End With
1260 End If
1270 End If
1280 End If
1290 Unload Me
1300 Set objDoc = Nothing
1310 Set objWord = Nothing
1320 Set objSel = Nothing
1330 On Error GoTo 0
1340 Exit Sub
cmdMail_Click_Error:
1350 objWord.ScreenUpdating = True
1360 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Zeile " & Erl() & " procedure cmdMail_Click of Formular frmMailversand"
End Sub
Das ist zwar nur die Hauptfunktion, enthält aber für einen ambitionierten Anwender so ziemlich alle notwendigen Bestandteile. Wer möchte kann es sich anschauen.
Ich nutze dieses Makro jetzt seit wir DATEV nutzen und es hat mich nie im Stich gelassen. 
Gruß A. Martens
Hilf dir selbst, dann hilft dir Gott.