VBA-Makro für Seriendruck mit Word und WHFC

Vorrausgesetzt wird eine funktionierende Installation von WHFC, sowie die Anpassung der Druckernamen vor dem Einsatz.

• Word zeigt immer eine Seite nach der letzte Seite an, obwohl eine Felder angezeigt und diese Seite auch nicht ausgedruckt wird. Deshalb kommt am Ende eine Fehlermeldung, anstatt einer ordentlichen Erfolgsmeldung. Dadurch ist auch Nmbofaxes eins höher als erwartet, was ich mit -1 ausgeglichen habe. Bei späteren Word-versionen als 2000 könnte der Fehler nicht bestehen und daher die letzte Seite bzw. das letzte Fax dann nicht gesendet werden. Also vorher prüfen!

Function Sonderzeichen_raus(ZeichenKette As String)
' löscht bzw. ersetzt die Sonderzeichen
ZeichenKette = Replace(ZeichenKette, "/", "")
ZeichenKette = Replace(ZeichenKette, "(", "")
ZeichenKette = Replace(ZeichenKette, ")", "")
ZeichenKette = Replace(ZeichenKette, " ", "")
ZeichenKette = Replace(ZeichenKette, "-", "")
ZeichenKette = Replace(ZeichenKette, "#", "")
ZeichenKette = Replace(ZeichenKette, ",", "")
ZeichenKette = Replace(ZeichenKette, ".", "")
ZeichenKette = Replace(ZeichenKette, "+", "00")
Sonderzeichen_raus = ZeichenKette
 
End Function
 
 
Sub SerienFax()
'********Makro SerienfaxDrucken*******************************
'
' SerienFax Macro
' Dieses Makro erstellt Serienfaxe auf Basis eines Word-Seriendruckdokumentes
' Es basiert auf einem Macro von Keith Gray,
' und wurde angepasst von Detlev Reymann am 22.3.99
' weitere Anpassung Stefan Kuchling 2007 (Sonderzeichen_raus: Fehlerbehandlung beim nicht-nummerischen Fax-Nummern)
 
' Variablen definieren
Dim whfc As Object
Dim OLE_Return As Long
Dim FaxNummer As String
Dim SpoolFile As String
Dim Title As String
Dim WhfcPrinter As String
Dim NbrOfFields As Integer
Dim j As Integer
Dim TelefaxNrFeld As Integer
Dim Ergebnis As Integer
Dim NmbOfFaxes As Integer
 
' Damit das Makro funktioniert muß das aktive Dokument ein Serienbriefhauptdokument sein
' und es muß eine Datei mit den Datensätzen definiert sein.
' Das wird im folgenden überprüft
If ActiveDocument.MailMerge.State <> wdMainAndDataSource Then
    Ergebnis = MsgBox("Kein Seriendruckdokument oder keine Datenquelle", vbInformation, "Achtung")
    Exit Sub
End If
 
' Feststellen wieviele Faxe geschickt werden sollen
' Dazu Nummer des letzten Datensatzes feststellen
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
NmbOfFaxes = ActiveDocument.MailMerge.DataSource.ActiveRecord
 
' Ersten Datensatz zum aktiven Datensatz machen
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
 
' Feststellen, welches Datenfeld die Bezeichnung Telefax enthält
' Das sollte es möglich machen, an beliebiger Stelle ein Feld
' für die Telefaxnummer zu definieren. es muß nur der Text
' fax in der Feldbezeichnung vorkommen.
' Es müßte also auch Telefax-Nr funktionieren
NbrOfFields = ActiveDocument.MailMerge.DataSource.DataFields.Count
' j speichert die Feldnummer
For j = 1 To NbrOfFields
    If InStr(1, ActiveDocument.MailMerge.DataSource.DataFields(j).Name, "fax") > 0 Then
        TelefaxNrFeld = j
        Exit For
    End If
Next j
 
' Wenn kein Datenfeld für die Faxnummer gefunden wurde
' das Makro abbrechen
If j > NbrOfFields Then
    Ergebnis = MsgBox("Kein Datenfeld für die Telefaxnummer definiert", vbInformation, "Achtung")
    Exit Sub
End If
 
' OLE-Verbindung zu WHFC herstellen
Set whfc = CreateObject("WHFC.OleSrv")
 
' Jetzt in einer Schleife die Faxe drucken
Dim i As Integer
For i = 1 To NmbOfFaxes
    ' Für jedes einzelne Fax eine temporäre Datei
    ' Hier muß ggf. wieder der Pfad angepaßt werden
    SpoolFile = "C:\Tempwhfcfax" & i & ".ps"
    Title = "WHFC OLE Serienfaxmakro"
 
    ' Die aktualisierten Datenfelder anzeigen
    ' Das ermöglicht die Verwendung der Seriendruckfelder im Hauptdokument
    ' und sorgt dafür, daß die korrekten Werte des aktiven Records
    ' angezeigt werden
    ActiveWindow.View.ShowFieldCodes = False
    ActiveWindow.View.MailMergeDataView = True
 
    ' Die Faxnummer aus dem Feld nehmen, daß oben ermittelt wurde
    FaxNummer = CStr(ActiveDocument.MailMerge.DataSource.DataFields(j)) '##
 
    ' evtuelle Sonderzeichen aus der FaxNummer nehmen (Funktion Sonderzeichen_raus aufrufen)
    FaxNummer = Sonderzeichen_raus(FaxNummer)
 
    ' Fax nur schicken, wenn Faxnummer eingetragen ist
    If FaxNummer > "" Then
 
     'Prüfen ob die Funktion wirklich nur Zahlen übrig gelassen hat
     If IsNumeric(FaxNummer) Then
 
        ' Einen Postscriptdrucker als Drucker festlegen
        ' Achtung !!!!!!!!!!!!!!!!!!!!!!!!!
        ' Hier muß ggf. der eigene Postscriptdrucker eingetragen werden
        ' Ich hatte hier Probleme, den WHFC-Drucker zu verwenden und habe
        ' extra einen Postscriptdrucker mit Ausgabe in eine Datei definiert
        WhfcPrinter = "WHFC Fax"
        'oder z.B. Apple Color LW 12/600 PS"
        ActivePrinter = WhfcPrinter$
 
        ' Jeweils das ganze Dokument drucken
        Application.PrintOut FileName:="", Range:=wdPrintAllDocument, _
            Item:=wdPrintDocumentContent, Copies:=1, Pages:="", _
            PageType:=wdPrintAllPages, Collate:=True, Background:=True, _
            PrintToFile:=True, OutputFileName:=SpoolFile, Append:=False
 
        ' Mit diesem Kommando wird das jeweilige Fax an WHFC übergeben und von
        ' diesem an den Faxserver weitergeleitet.
        OLE_Return = whfc.SendFax(SpoolFile, FaxNummer, True)
        ' Falls das nicht klappt, Fehlermeldung
        If OLE_Return <= 0 Then
            Ergebnis = MsgBox("Fehler bei Verbindung zu WHFC", 16, Title)
        End If
 
     End If
    End If
    ' Nächsten Datensatz holen
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next i
 
Set whfc = Nothing
' Wieder Standarddrucker einstellen
' Auch hier bitte den eigenen Standarddrucker eintragen
ActivePrinter = "Automatisch HP LaserJet 4 auf FAX-C4"
End Sub

Quelle