wir haben eine Word-Vorlage aufgebaut mit mehreren Abschnitten.
Das Worddokument habe ich mal als Bild angehängt.
Sub Initialize
Dim session As New NotesSession
Dim workspace As New NotesUIWorkspace
Dim db As NotesDatabase 'The current database
Dim view As NotesView
Dim varValue As Variant
Dim varFile As Variant
Dim strVorlage As String
Dim strSteuerdatei As String
Dim strPfad As String
Dim strHeader As String
Dim strBriefAnrede As String
Dim strAnrede As String
Dim iFileNum As Integer
Dim idx As Integer
Dim cSeriendruck As cSeriendruck2K
Dim entry As NotesViewEntry
Dim vc As NotesViewEntryCollection
On Error Goto ErrHandler
Set db = session.CurrentDatabase
Set view = db.GetView("AnR")
Set vc = view.AllEntries
'Pfad und Steuerdatei
strPfad = "C:\Vorlagen\ZNotes\"
If Right$(strPfad, 1) <> "\" Then strPfad = strPfad & "\"
strSteuerdatei = strPfad & "adressen.doc"
strVorlage = "C:\Vorlagen\zNotes\Adressenliste.dot"
'Header für Steuerdatei
strHeader = "Funktion""" + "," + """Unterfunktion"""+ "," + """Gewerk1"""+ "," + """Gewerk2""" + "," + """Person""" +_
","+ """Projekt""" + "," + """Projektnummer"""_
+ "," +"""Firmenname""" + "," +"""Abteilung""" + "," + """Firmenadresse""" + "," + """Telefon"""+ "," + """Handy""" + "," _
+ """Fax"""+ "," +"""eMail"
'Erzeugen der Steuerdatei und Schreiben des Headers
iFileNum = Freefile()
Open strSteuerdatei For Output As iFileNum
Write #iFileNum, strHeader
'Einfügen der "Datensätze" in Steuerdatei
Dim i As Integer
Dim varfunk1 As String
Dim varsubfunk1 As String
Set entry = vc.GetNthEntry(1)
Set doc = entry.Document
varfunk1 = Strright(doc.Funktion(0)," ")
varsubfunk1 = doc.Funktion2(0)
For i=1 To vc.count
Set entry = vc.GetNthEntry(i)
Set doc = entry.Document
Dim varfunk As String
Dim varfunk2 As String
Dim varsubfunk As String
Dim varsubfunk2 As String
varfunk2 = Strright(doc.Funktion(0)," ")
If i = 1 Then
varfunk=varfunk1
Elseif varfunk1 = varfunk2 Then
varfunk = ""
Else
varfunk1 = varfunk2
varfunk = varfunk2
End If
varsubfunk2 = doc.Funktion2(0)
If i = 1 And varsubfunk="" Or varsubfunk="-" Or varsubfunk1 = varsubfunk2 Then
varsubfunk=""
Else
varsubfunk1 = varsubfunk2
varsubfunk = varsubfunk2
End If
Dim varproj As String
varproj = Right$( doc.Projekt(0),Len(doc.Projekt(0))-(Len(doc.Projektnummer(0))+1))
Dim vargew As Variant
Dim vargewstr As String
Dim total As Integer
vargew =doc.GetItemValue( "Gewerk" )
If vargew(0)= "" Then
vargewstr=""
Else
total=0
Forall a In vargew
If vargewstr = "" Then
vargewstr=Cstr(vargew(total))
total = total +1
Else
vargewstr=vargewstr & ", " & Cstr(vargew(total))
total = total +1
End If
End Forall
End If
Write #iFileNum, varfunk,varsubfunk, doc.Gewerk1(0),vargewstr, doc.Ansprechpartner(0)_
,varproj,doc.Projektnummer(0),doc.Unternehmen(0), doc.Abteilung(0),doc.U_Adresse(0), doc.A_Telefon(0)_
,doc.A_Handy(0), doc.A_Fax(0), doc.A_eMail(0)
vargewstr = ""
Next
Close #iFileNum 'Schließen der Steuerdatei
Set cSeriendruck = New cSeriendruck2K 'Neue Instanz der Klasse cSeriendruck
Call cSeriendruck.OpenDoc(strVorlage) 'Öffnen der Serienbriefvorlage
Call cSeriendruck.Merge(strSteuerdatei) 'Verbinden mit Steuerdatei, erzeugt ein neues Dokument
Call cSeriendruck.ActivateWord 'Word in den Vordergrund bringen
Call cSeriendruck.CloseDoc(strVorlage) 'Schließen der Vorlage
Delete cSeriendruck
Exit Sub
ErrHandler:
If Err = 76 Then
Messagebox "Die Serienbrief-Datei kann nicht erstellt werden." + Chr$(13) + "Das Verzeichnis " + Strleftback(dlgdoc.xSteuerdatei(0),"\") +_
" ist nicht vorhanden" , 16, "Fehler"
Else
Messagebox "Die Serienbrief-Datei konnte nicht erstellt werden." + Chr$(13) + "Fehler: " + Str$(Err) + " -> '" + Error$ + _
"' in Zeile " + Str$(Erl) , 16, "Fehler"
End If
'Aufräumen
Close #iFileNum
If Not (cSeriendruck Is Nothing) Then Delete cSeriendruck 'Wenn eine Instanz der Klasse vorhanden, löschen
Exit Sub
End Sub
Umfrage
Thema: Exort von Datenaus Lotus Notes nach Word (Gelesen 12538 mal)