Office: Serienbrief in einzelnen Dokumenten speichern

holger-wi · 26. Juni 2016

Hallo Gemeinde,
leider versuche ich schon den ganzen Abend, ein Seriendokument in einzelnen Dateien zu speichern.
Ich möchte die fertige Datei anschließend digital versenden.
Ich habe es bisher mit diversen VBA-Scripts probiert, doch scheint das Problem zu sein, dass die Benennung der Datei nicht funktioniert. Das erste Dokument wird erstellt ("SerienbriefXX.docx) und dann bricht das Makro mit der Fehlermeldung "Der ausgewählte Speicherort ist Ungültig" ab. Ich habe die Befürchtung, dass es die zweite Datei unter dem selben Namen abspeichern will, obwohl es eigentlich mit dem Namen versehen sien sollte.
Kann mir jemand sagen, wo ich meinen Fehler habe?

Vielen Dank!
Holger-wi
Code:

Sub Serienbrief()
' set variables
Dim iBrief As Integer, sBrief As String
Dim AppShell As Object
Dim BrowseDir As Variant
Dim Path As String

' catch any errors
On Error GoTo ErrorHandling

' determine path
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Speicherort für Serienbriefe auswählen", 0, 16)

If BrowseDir = "Desktop" Then
Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Else
Path = BrowseDir.items().Item().Path
End If

If Path = "" Then GoTo ErrorHandling

Path = Path & "\Serienbrief-" & Format(Now, "dd.mm.yyyy-hh.mm.ss") & "\"
MkDir Path

On Error GoTo ErrorHandling

' hide application for better performance
MsgBox "Serienbriefe werden exportiert. Dieser Vorganag kann einige Minuten dauern - Microsoft Word wird während dieser Zeit ausgeblendet", vbOKOnly + vbInformation
Application.Visible = False

' create bulkletter and export as pdf
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
sBrief = Path & .DataFields("Name").Value & ".docx"
End With
.Execute Pause:=False

If .DataSource.DataFields("Name").Value > "" Then
ActiveDocument.SaveAs FileName:=sBrief
End If
ActiveDocument.Close False

If .DataSource.ActiveRecord < .DataSource.RecordCount Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If
Loop
End With

' error handling
ErrorHandling:
Application.Visible = True

If Err.Number = 76 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
ElseIf Err.Number = 5852 Then
MsgBox "Das Dokument ist kein Serienbrief"
ElseIf Err.Number = 4198 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
ElseIf Err.Number = 91 Then
MsgBox "Exportieren von Serienbriefen abgebrochen", vbOKOnly + vbExclamation
ElseIf Err.Number > 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro erneut ausführen.", vbOKOnly + vbCritical
Else
MsgBox "Serienbriefe erfolgreich exportiert", vbOKOnly + vbInformation
End If

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

Gerhard H · 28. Juni 2016

Hallo Holger,

das Skript läuft bei mir ohne Macken durch. Um rauszufinden, was bei dir los ist, könntest du so vorgehen:

1.
Es ist nicht klar, welcher Fehler eigentlich eingetreten ist: In dem Script stehen unter zwei verschiedenen Fehlernummern (76 und 4198) identische Fehlerbeschreibungen. Um rauszufinden, welche Fehlernummer ausgelöst worden ist, könntest du die beiden Meldungen wie folgt ergänzt:
Code:

MsgBox Err.Number & "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Welche Fehlernummer wird dann angezeigt?

2.
Speichere in einen "unverdächtigen" Ordner. Erstelle dir dazu den Ordner tmp direkt unter C:\, kommentiere alle Zeilen aus, die sich mit der Ordnererstellung befassen und ersetze sie durch die letzte Zeile, also so:
Code:

' determine path
' Set AppShell = CreateObject("Shell.Application")
' Set BrowseDir = AppShell.BrowseForFolder(0, "Speicherort für Serienbriefe auswählen", 0, 16)
'
' If BrowseDir = "Desktop" Then
' Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")
' Else
' Path = BrowseDir.items().Item().Path
' End If
'
' If Path = "" Then GoTo ErrorHandling
'
' Path = Path & "\Serienbrief-" & Format(Now, "dd.mm.yyyy-hh.mm.ss") & "\"
' MkDir Path
Path = "C:\tmp\"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn das Makro dann immer noch abbricht, drängt sich die Frage auf, ob was mit deiner Datenquelle nicht stimmt (diesen Verdacht habe ich auch, weil du offenbar schon mehrere Skripte erfolglos ausprobiert hast).

3.
Könnte es sein, dass deine Namen in der Datenquelle Zeichen enthalten, die in Dateinamen nicht erlaubt sind? Wie lauten denn die beiden ersten Einträge in deiner Datenquelle in der Spalte "Name"?

holger-wi · 28. Juni 2016

Guten Morgen Gerhard,
danke für Deine Hilfe.
Was ich vergessen habe ist, dass ich Word2016 nutze. Vielleicht ist das auch ein Grund?
Ich habe die Punkte, die Du geschrieben hast geändert, aber leider hat es sich bisher nicht gebessert. Das Feld "Name" besteht aus "Nachname, Vorname": Ih habe aber auch ein anderes Feld versucht und es scheint trotzdem nicht zu funktionieren.
Ich habe noch eine Möglichkeit, es auf Word 2013 zu versuchen. Bin gespannt, ob es dann vielleicht funktioniert.

Grüße
Holger

holger-wi · 28. Juni 2016

Hallo Gerhard,
ich habe das selbe Makro noch mal auf Word2013 laufen lassen und hier funktioniert es.
Da scheint man wohl wieder etwas in den Befehlen geändert zu haben.
Vielen Dank für Deine Hilfe!

Grüße
Holger

haklesoft · 28. Juni 2016

Hallo Holger,

ich würde unmittelbar vor dem ErrorHandling: zunächst mal ein Exit Sub einfügen.

holger-wi · 29. Juni 2016

Hallo haklesoft,

dein Vorschlag mit dem Exit sub macht keinen Unterschied.
Was mir heute noch aufgefallen ist. Wenn ich das Makro mit word2016 starte, kommt bei der sich öffnenden Ordnerauswahl nur der Desktop mit seinen Unterordnern als Auswahl. Starte ich das selbe Makro auf Word2013 kommt die komplette Ordnerstruktur. Vielleicht ist das ja ein Grund, warum es nicht funktioniert.

Sollte jemand noch eine Idee haben, warum es nicht auf word2016 funktioniert, ich probiere es gerne aus.

Grüße
Holger

Gerhard H · 29. Juni 2016

Hallo Holger,

über die Unterschiede zwischen Word 2013 und 2016 bezüglich des Shell-Objekts kann ich dir nichts sagen, da ich noch mit Version 2010 arbeite. Aber du könntest zwei Alternativen ausprobieren, von denen ich denke, dass ihnen die Word-Version wurscht ist:

Entweder du gibst den Zielordner im Makro direkt vor, wie in Beitrag 2 vorgeschlagen:
Code:

Path = "C:\tmp\"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Oder du wählst den Zielordner ausgehend von einem Ausgangsordner selber, und zwar mit Hilfe des Folder-Pickers (im Unterschied zu dem Originalmakro wird dieser Ordner nicht erstellt, sondern muss schon existieren). Das sähe dann so aus:
Code:

Sub Serienbriefe()
Dim picker As FileDialog
Dim ausgangsOrdner As String, zielOrdner As String
Dim sBrief As String

'Zielordner wählen
ausgangsOrdner = "F:\"
Set picker = Application.FileDialog(msoFileDialogFolderPicker)

With picker
.AllowMultiSelect = False
.InitialFileName = ausgangsOrdner
If .Show = -1 Then
zielOrdner = .SelectedItems(1) & "\"
End If
End With

'***der Rest ist im Groben und Ganzen das alte Makro
'***ergänzt um die Variante PDF-Export

On Error GoTo ErrorHandling

' hide application for better performance
MsgBox "Serienbriefe werden exportiert. Dieser Vorganag kann einige Minuten dauern - Microsoft Word wird während dieser Zeit ausgeblendet", vbOKOnly + vbInformation
Application.Visible = False

' create bulkletter and export as pdf
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = 1

Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True

With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord

MsgBox zielOrdner & " " & .DataFields("Name").Value
sBrief = zielOrdner & .DataFields("Name").Value

End With
.Execute Pause:=False

If .DataSource.DataFields("Name").Value > "" Then
'im Word-Format speichern
'ActiveDocument.SaveAs2 FileName:=sBrief, fileformat:=wdFormatDocumentDefault
'oder als pdf exportieren
ActiveDocument.ExportAsFixedFormat outputfilename:=sBrief, exportformat:=wdExportFormatPDF
End If
ActiveDocument.Close False

If .DataSource.ActiveRecord < .DataSource.RecordCount Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If
Loop
End With
MsgBox "Serienbriefe erfolgreich exportiert", vbOKOnly + vbInformation
Exit Sub

ErrorHandling:
Application.Visible = True

If Err.Number = 76 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
ElseIf Err.Number = 5852 Then
MsgBox "Das Dokument ist kein Serienbrief"
ElseIf Err.Number = 4198 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
ElseIf Err.Number = 91 Then
MsgBox "Exportieren von Serienbriefen abgebrochen", vbOKOnly + vbExclamation
ElseIf Err.Number > 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro erneut ausführen.", vbOKOnly + vbCritical
Else
MsgBox Err.Number & ": " & Err.Description
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

holger-wi · 12. Juli 2016

Hallo Gerhard,

leider komme ich jetzt erst dazu, Dir zu antworten.
Ich habe Deine zwei Möglichkeiten ausprobiert.
Das direkte Angeben des Pfads hat nicht geholfen,
Dein Skript jedoch funktioniert!
Muss es mir jetzt mal zu Gemüte führen, was Du genau geändert hast und was das für Auswirkungen auf die Office-Version haben könnte.

Vielen Dank Für die Unterstützung!!!

Grüße
Holger

Office: Serienbrief in einzelnen Dokumenten speichern

Serienbrief in einzelnen Dokumenten speichern

Serienbrief in einzelnen Dokumenten speichern

Serienbrief in einzelnen Dokumenten speichern

Serienbrief in einzelnen Dokumenten speichern

Serienbrief in einzelnen Dokumenten speichern - Similar Threads - Serienbrief einzelnen Dokumenten

VBA Serienbrief in einzelne Ordner speichern

VBA - Serienbriefe in einzelnen Dokumenten speichern

Word, Excel Serienbrief Makro in einzelne Datein

Serienbriefe einzeln speichern

Serienbrief als einzelne Word-Dateien speichern

Serienbriefe in einzelne PDF-Datei exportieren

Serienbrief erstellen und Tabellen einzeln als Anhang einfügen