Unterschiede

Hier werden die Unterschiede zwischen zwei Versionen angezeigt.

--- hylafax:vba-makro_word_und_whfc [2007/03/27 10:01] – angelegt st
+++ hylafax:vba-makro_word_und_whfc [2007/12/04 04:17] (aktuell) – st
@@ Zeile 1: / Zeile 1: @@
+====== VBA-Makro für Seriendruck mit Word und WHFC ======
+Vorrausgesetzt wird eine funktionierende Installation von [[http://whfc.uli-eckhardt.de/|WHFC]], sowie die Anpassung der Druckernamen vor dem Einsatz.
+===== Hinweise =====
+  * 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!
+===== Code =====
+<code vb>
+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
+</code>
+[[http://thorin.de/faxcl/serienfax.macro|Quelle]]