Fehler 5631 bei Serienbrief
31.03.2021 10:51:05
Anton
Ich hätte da ein kleines Problem, bei dem ich nicht weiterkomme:
Ich habe einen Serienbrief erstellt (Word 2010), mit dem ich Rechnungen ausdrucke, das funktioniert auch sehr gut.
Auch wenn ich in dem Serienbrief folgende Regel einbaue: Überspringe Datensatz, wenn Rechnungbetrag = 0. Dann werden auch nur Belege gedruckt, die einen >0,00 Rechnungbetrag enthalten. Soweit noch alles ohne das VBA-Script.
Nun möchte ich diese Belege nicht nur drucken, sondern auch als PDF einzeln speichern. Dafür ist dann das nachfolgende Script gedacht, welches mir die Belege einzeln abspeichern soll. (Das Script ist nicht von mir, sondern habe ich mir im Netz zusammengesucht).
Das klappt aber nur, wenn ich die oben genannte Regel nicht im Serienbrief eingebaut habe. Allerdings bekomme ich dann auch alle Belege gespeichert, auch die, die einen Betrag von 0,00 haben. Baue ich die Regel wieder ein, bekomme ich die Fehlermeldung 5631 Word konnte das Hauptdokument nicht mit der Datenquelle verbinden, da entweder die Datensätze leer waren oder kein Datensatz den Abfrageoptionen entsprach. Und das Makro bricht ab.
Es liegt vermutlich an den Rechnungen mit dem Betrag 0,00, die übersprungen werden sollen.
Wie müsste ich nun das Script anpassen, damit ich die Regel beibehalten kann, bzw. dass ich nur die Belege gespeichert bekomme, die einen Rechnungsbetrag >0,00 haben?
Ich würde mich sehr über einen Lösungsvorschlag freuen.
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")
strStartPath = "g:\Rechnungen\"
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, (strStartPath))
'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 Vorgang 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 & ", " & .DataFields("Vorname") & " - _
" & .DataFields("Rechnungsnummer") & " -" & .DataFields("Betrag") & " " & ".pdf"
'sBrief = Path & .DataFields("Name").Value & ".pdf" Betrag MERGE-FORMAT
End With
.Execute Pause:=False
'ActiveDocument.AcceptAllRevisions
'If .DataSource.DataFields("Name").Value > "" Then
If .DataSource.DataFields("Name").Value > "" Then
ActiveDocument.SaveAs FileName:=sBrief, FileFormat:=wdFormatPDF
End If
ActiveDocument.Close False
If .DataSource.ActiveRecord 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro erneut ausführen.", _
vbOKOnly + vbCritical
Else
MsgBox "Serienbriefe erfolgreich exportiert", vbOKOnly + vbInformation
End If
ActiveDocument.Close wdDoNotSaveChanges
End Sub