Autor Thema: Adressenetiketten aus LN erstellen (Gelesen 14516 mal)

RonMat · « **am:** 19.03.03 - 11:12:47 »

Hallo Ihr da draußen, hat jemand einen Ansatz für mich? Folgendes Problem:
ich habe eine Datenbank erstellt (KundenDB) mit der man Serienbriefe etc erstellen kann. Alles kein Problem - aber jetzt habe ich eine Anforderung hierfür erhalten die mich verzweifeln lässt. Aus bestimmten Adressen sollen Etiketten gedruckt werden?!?!
Beispiel: Zweckform XYZ mit 12 Etiketten, ausgewählte Adressenanzahl 5, 7 Etiketten bleiben unbenutzt

Die Idee des Kunden die Etikettenfolge zu bestimmen ist gut - aber wie??? Es muß eine LN-Lösung sein, Office steht nicht z.Verfügung
- also keine Bookmarks.
Habe schon im WEB mir die Augen rausgeschaut - narda. Bin für jeden Ansatz/Gedankengang dankbar.

eknori · « **Antwort #1 am:** 19.03.03 - 11:16:15 »

http://www.eknori.de/downloads/Label.zip

RonMat · « **Antwort #2 am:** 19.03.03 - 11:40:55 »

Hallo Eknori,
danke für die schnelle Antwort. Hab ich entpackt, es tut sich aber nix wenn ich auf Printlabel gehe. Ich schau mir mal das Script an, vielleicht werde ich ja fündig. Bei mir druckt´s nicht.

Axel · « **Antwort #3 am:** 19.03.03 - 11:46:47 »

Hi,

ohne Office bzw. andere Zusatztools wird's schwierig.

Einzigste Idee die ich im moment habe, waere ein Notesdokment mit einem RTF-Feld. In diesem Feld erzeugst du eine Tabelle mit den Abmessungen der Aufkleber. Wie gesagt, ist nur eine Idee. Ob und wie so was funktionieren kann, vermag ich nicht einzuschätzen.

Axel

@eknori
Deine Lösung ist zwar sehr gut, aber hier nicht verwendbar, denn

Zitat

Es muß eine LN-Lösung sein, Office steht nicht z.Verfügung

eknori · « **Antwort #4 am:** 19.03.03 - 11:48:08 »

@Axel: yoo, hab ich zu spät gesehen; irgendwie dicke Augen heute

ata · « **Antwort #5 am:** 19.03.03 - 11:50:54 »

... ich hab noch nen Code in meiner KB - allerdings nicht explicit getestet...

Code


This one is for easyly create Labels with MS-Word
 
Code 
 
' Sample Usage:
 
Sub Click(Source As Button)
Call CreateMailingLabels("Title","FirstName, LastName" , 
"OfficeStreetAddress","Zip","City" , True , 5 , "L7690")
End Sub
 
 
Sub CreateMailingLabels(Line1Fields As Variant ,_
Line2Fields As Variant ,_
Line3Fields As Variant ,_
Line4Fields As Variant ,_
Line5Fields As Variant ,_
Skip As Variant ,_
ColCount As Integer ,_
LabelTemplate As String) 
 
Const OLE_OBJECT = "Word.Application" 
 
Dim ws As New NotesUIWorkspace 
Dim s As New NotesSession
Dim db As notesdatabase
Dim doc As NotesDocument
Dim dc As NotesDocumentCollection 
Dim wrd As Variant 
Dim LabelCount As Long
Dim DivMod As Integer
 
cr = Chr ( 13 ) & Chr ( 10 ) 
wdCell = 12 
LabelCount=1 
DivMod = 1 
 
Set db = s.CurrentDatabase
Set dc=db.UnProcessedDocuments
 
Set wrd = CreateObject ( OLE_OBJECT ) 
Call wrd.Documents.Add 
Call wrd.MailingLabel.CreateNewDocument ( LabelTemplate ) 
wrd.visible = True
Set doc=dc.GetFirstDocument
 
While Not doc Is Nothing
LabelAddress = GetListFieldValues ( doc , Line1Fields ) & cr '// 
Build label text
LabelAddress = LabelAddress & GetListFieldValues ( doc , Line2Fields 
) & cr
LabelAddress = LabelAddress & GetListFieldValues ( doc , Line3Fields 
) & cr
LabelAddress = LabelAddress & GetListFieldValues ( doc , Line4Fields 
) & cr
LabelAddress = LabelAddress & GetListFieldValues ( doc , Line5Fields )
 
If Not SingleColumn% Then
Call wrd.Selection.TypeText ( LabelAddress ) '// Insert Label 
Text
On Error Goto TrapSingleColumn
 
If Skip = False Then 
Call wrd.Selection.MoveRight ( wdCell ) ' Move one cell to 
the right. 
Else
If DivMod = 0 Then
Call wrd.Selection.MoveRight ( wdCell ) ' Move one 
cell to the right. 
Else 
Call wrd.Selection.MoveRight ( wdCell ) ' Move one 
cell to the right. 
Call wrd.Selection.MoveRight ( wdCell ) ' Move one 
cell to the right. 
End If
End If
 
If SingleColumn% Then 
Call wrd.MailingLabel.CreateNewDocument ( LabelTemplate , 
LabelAddress ) 
End If
 
Else
Call wrd.MailingLabel.CreateNewDocument ( LabelTemplate , 
LabelAddress ) 
End If
 
LabelCount = LabelCount + 1
 
If ColCount = 2 Then 
DivMod = 1
Else
DivMod = Labelcount Mod ColCount
End If 
 
Set doc = dc.GetNextDocument ( doc )
 
Wend
 
Exit Sub
 
TrapSingleColumn:
SingleColumn% = True
Resume Next
 
End Sub
 
Function GetListFieldValues ( doc As NotesDocument , FieldList As Variant ) As 
String
Dim TempList As String
Dim TempOutput As String
Dim TempArray As Variant
Dim ThisField As String
 
TempList = FieldList
TempOutput = ""
If TempList <> "" Then
' parse list of fields 
While Len ( TempList ) > 0
If Instr ( TempList , "," ) > 0 Then
ThisField = Trim ( Left$ ( TempList , Instr ( TempList , 
"," ) - 1 ) )
TempList = Right$ ( TempList , Len ( TempList ) - Instr ( 
TempList , "," ) )
Else
ThisField = Trim ( TempList )
TempList = ""
End If
' retrieve notes field <WHATLE

ata

eknori · « **Antwort #6 am:** 19.03.03 - 12:12:08 »

Zitat

This one is for easyly create Labels with MS-Word

auch reingefallen

; es soll doch eine reine LN Lösung sein.

ata · « **Antwort #7 am:** 19.03.03 - 12:51:20 »

... upps - wer lesen kann ist im Vorteil...

- sorry

ata

Rootine · « **Antwort #8 am:** 19.03.03 - 16:34:37 »

ok, einfach mal so dahergedacht:
der kunde muss ja vorher irgendwo dem system bekannt geben welche etiketten schon verbraucht worden sind. diese etikettenfelder würd ich dann einfach als belegte felder behandeln in denen immer die gleiche andresse drinnen steht, nämlich eine leere.

lg
roo

Rob Green · « **Antwort #9 am:** 19.03.03 - 16:51:20 »

dann schau Dir NotesToPaper an...mögl. wäre das etwas. Koscht aber.

adminnaddel · « **Antwort #10 am:** 19.03.03 - 20:37:06 »

@eknori

ist es mir möglich (mal umständlich gedacht) deine konfiguration an eine bestimmte data becker norm anzugleichen?

grüße
Andreas

Don Pasquale · « **Antwort #11 am:** 20.03.03 - 13:04:30 »

Zitat von: eknori am 19.03.03 - 11:16:15

http://www.eknori.de/downloads/Label.zip

Interessant,

warum öffnet sich Word eigentlich zweimal :-) ?

Ciao Don Pasquale

Axel · « **Antwort #12 am:** 20.03.03 - 13:28:13 »

Hi,

das liegt an dieser Zeile in der Routine CreateMailingLabels:

Set wrd = CreateObject ( "Word.Application" )

Der Funktion CreateObject ist es egal ob ein Wordtask vorhanden ist oder nicht. Es wird immer ein neuer gestartet.

Ich hab' s so gelöst:

...
On Error Resume Next
Set objWord = GetObject("", "Word.Application")
If Err = 208 Then ' Fehler 208 tritt auf wenn Word noch nicht läuft
Err = 0
Set objWord = CreateObject("Word.Application")
objWord.Visible = True 'Word sichtbar machen
End If
...

Ich versuche erst auf eine bestehende Task zuzugreifen, wenn das nicht gelingt, weil Word eben noch nicht läuft, starte ich es.

Axel

ata · « **Antwort #13 am:** 20.03.03 - 13:31:57 »

@Axel

... rafitükisch...

ata

Don Pasquale · « **Antwort #14 am:** 20.03.03 - 14:04:14 »

Zitat von: Axel am 20.03.03 - 13:28:13

das liegt an dieser Zeile in der Routine CreateMailingLabels:
Set wrd = CreateObject ( "Word.Application" )

Ich weiß :-)

Deine Lösung funktioniert prima.

Ich wollte nur vorlaut sein.

Ciao

Don Pasquale

Xantox · « **Antwort #15 am:** 27.11.03 - 13:26:15 »

Zitat von: Axel am 20.03.03 - 13:28:13

Hi,

das liegt an dieser Zeile in der Routine CreateMailingLabels:

Set wrd = CreateObject ( "Word.Application" )

Der Funktion CreateObject ist es egal ob ein Wordtask vorhanden ist oder nicht. Es wird immer ein neuer gestartet.

Ich hab' s so gelöst:

...
On Error Resume Next
Set objWord = GetObject("", "Word.Application")
If Err = 208 Then ' Fehler 208 tritt auf wenn Word noch nicht läuft
Err = 0
Set objWord = CreateObject("Word.Application")
objWord.Visible = True 'Word sichtbar machen
End If
...

Ich versuche erst auf eine bestehende Task zuzugreifen, wenn das nicht gelingt, weil Word eben noch nicht läuft, starte ich es.

Axel

Hallo Axel,

wo hast Du denn Deine Änderung im Script eingetragen? magst du vielleicht dein modifiziertes script posten?

habe ich das richtig verstanden und es wird dann nicht eine extra word-session beim erstellen der labels geöffnet, sondern die vorhandene genommen?

Bei dem script ist bei mir immer der fehler aufgetreten, das nach dem korrekten erstellen der labels und schliessen von word die wordsession sich bei den diensten nicht beendet hat. Somit ist dann immer das "temp.doc" von word geöffnet geblieben und eine fehlermeldung erscheint, das die "temp.doch" gerade in verwendung ist beim erneuten ausführen des labelagenten.

ist dieser fehler dann evtl. auch behoben?

Grüße Xantox

Axel · « **Antwort #16 am:** 27.11.03 - 14:18:10 »

Hi,

welches Script verwendest du denn? Ist eknoris oder atas Lösung?

Axel

Xantox · « **Antwort #17 am:** 27.11.03 - 14:25:54 »

ich verwende das script von eknori.

Grüße

Axel · « **Antwort #18 am:** 27.11.03 - 15:13:25 »

Hi,

du musst nur die Zeile Set wrd = CreateObject ( "Word.Application" ) durch meine Zeilen ersetzen.

Auszug aus eknoris Script (Routine CreateMailingLabels)

Zitat

   ...
cr = Chr ( 13 ) & Chr ( 10 )
   wdCell = 12
   LabelCount=1
   DivMod = 1

   Set db = s.CurrentDatabase
   Set dc=db.UnProcessedDocuments

   On Error Resume Next
Set wrd = GetObject("", "Word.Application")
If Err = 208 Then ' Fehler 208 tritt auf wenn Word noch nicht läuft
Err = 0
Set wrd = CreateObject("Word.Application")
End If

Call wrd.Documents.Add
   Call wrd.MailingLabel.CreateNewDocument ( LabelTemplate )
   wrd.visible = True
   Set doc=dc.GetFirstDocument

   While Not doc Is Nothing
      LabelAddress = GetListFieldValues ( doc , Line1Fields ) & cr '// Build label tex
...

Das hast du richtig verstanden. Wenn word bereits gestartet ist, wird diese Session benutzt, sonst wird Word aufgerufen.

Zu deinem anderen Problem kann ich im Moment nichts sagen, da im Orginalscript von eknori die Wordsession nicht beendet wird. Dazu bräuchte ich deinen Code.

Axel

Xantox · « **Antwort #19 am:** 27.11.03 - 15:30:47 »

Hallo Axel,

danke für die schnelle Antwort.
Ich werde das später gleich mal ausprobieren.

Zitat

Zu deinem anderen Problem kann ich im Moment nichts sagen, da im Orginalscript von eknori die Wordsession nicht beendet wird. Dazu bräuchte ich deinen Code.

Also mein Problem war/ist, das nachdem du deine Etiketten aus den gewünschten Kontakten über word gedruckt hast, das du dann zwar das word schliessen kannst. aber unter den diensten immer noch die winword-session läuft, die für das etikett gestartet worden ist.

durch das script wird ja für word temporär das "temp.doc" generiert, damit die adressendaten mit der vorlage von word zusammgefügt werden können.

jetzt schliesst du die wordanwendung, die winword-session bleibt geöffnet und somit auch das "temp.doc". jetzt möchte der user weitere etiketten drucken und das bricht dann mit der fehlermeldung ab, das das temp.doc bereits in verwendung sei.

jetzt kann ich natürlich meinen usern nicht erzählen, sie sollen in den task-manager gehen und alle ihre winwordsessions beenden

daher suche ich noch die lösung zu diesem problem *g*

Grüße

	This one is for easyly create Labels with MS-Word

	Code

	' Sample Usage:

	Sub Click(Source As Button)
	Call CreateMailingLabels("Title","FirstName, LastName" ,
	"OfficeStreetAddress","Zip","City" , True , 5 , "L7690")
	End Sub


	Sub CreateMailingLabels(Line1Fields As Variant ,_
	Line2Fields As Variant ,_
	Line3Fields As Variant ,_
	Line4Fields As Variant ,_
	Line5Fields As Variant ,_
	Skip As Variant ,_
	ColCount As Integer ,_
	LabelTemplate As String)

	Const OLE_OBJECT = "Word.Application"

	Dim ws As New NotesUIWorkspace
	Dim s As New NotesSession
	Dim db As notesdatabase
	Dim doc As NotesDocument
	Dim dc As NotesDocumentCollection
	Dim wrd As Variant
	Dim LabelCount As Long
	Dim DivMod As Integer

	cr = Chr ( 13 ) & Chr ( 10 )
	wdCell = 12
	LabelCount=1
	DivMod = 1

	Set db = s.CurrentDatabase
	Set dc=db.UnProcessedDocuments

	Set wrd = CreateObject ( OLE_OBJECT )
	Call wrd.Documents.Add
	Call wrd.MailingLabel.CreateNewDocument ( LabelTemplate )
	wrd.visible = True
	Set doc=dc.GetFirstDocument

	While Not doc Is Nothing
	LabelAddress = GetListFieldValues ( doc , Line1Fields ) & cr '//
	Build label text
	LabelAddress = LabelAddress & GetListFieldValues ( doc , Line2Fields
	) & cr
	LabelAddress = LabelAddress & GetListFieldValues ( doc , Line3Fields
	) & cr
	LabelAddress = LabelAddress & GetListFieldValues ( doc , Line4Fields
	) & cr
	LabelAddress = LabelAddress & GetListFieldValues ( doc , Line5Fields )

	If Not SingleColumn% Then
	Call wrd.Selection.TypeText ( LabelAddress ) '// Insert Label
	Text
	On Error Goto TrapSingleColumn

	If Skip = False Then
	Call wrd.Selection.MoveRight ( wdCell ) ' Move one cell to
	the right.
	Else
	If DivMod = 0 Then
	Call wrd.Selection.MoveRight ( wdCell ) ' Move one
	cell to the right.
	Else
	Call wrd.Selection.MoveRight ( wdCell ) ' Move one
	cell to the right.
	Call wrd.Selection.MoveRight ( wdCell ) ' Move one
	cell to the right.
	End If
	End If

	If SingleColumn% Then
	Call wrd.MailingLabel.CreateNewDocument ( LabelTemplate ,
	LabelAddress )
	End If

	Else
	Call wrd.MailingLabel.CreateNewDocument ( LabelTemplate ,
	LabelAddress )
	End If

	LabelCount = LabelCount + 1

	If ColCount = 2 Then
	DivMod = 1
	Else
	DivMod = Labelcount Mod ColCount
	End If

	Set doc = dc.GetNextDocument ( doc )

	Wend

	Exit Sub

	TrapSingleColumn:
	SingleColumn% = True
	Resume Next

	End Sub

	Function GetListFieldValues ( doc As NotesDocument , FieldList As Variant ) As
	String
	Dim TempList As String
	Dim TempOutput As String
	Dim TempArray As Variant
	Dim ThisField As String

	TempList = FieldList
	TempOutput = ""
	If TempList <> "" Then
	' parse list of fields
	While Len ( TempList ) > 0
	If Instr ( TempList , "," ) > 0 Then
	ThisField = Trim ( Left$ ( TempList , Instr ( TempList ,
	"," ) - 1 ) )
	TempList = Right$ ( TempList , Len ( TempList ) - Instr (
	TempList , "," ) )
	Else
	ThisField = Trim ( TempList )
	TempList = ""
	End If
	' retrieve notes field <WHATLE