HI Leute
ich habe da mal wieder eine kleine Frage und bräuchte eure Unterstützung.
Ich habe einen Button, mit dem ich markierte DOkumente aus einer Ansicht in ein WordDokument exportieren kann. Dies klappt soweit auch ganz gut. Jedoch möchte ich in diesem Worddokument die Zeile mit dem "TEXT" mit dem Format "Überschrift 3" aus Word belegen, ausserdem möchte ich nachdem das WordDokument komplett gefüllt ist noch ein Inhaltsverzeichnis erstellen.
Das Mit dem Format müsste irgendwie mit "Style" gehen, jeodch hab ich das noch nicht hinbekommen,
das mit dem Inhaltsverzeichnis muss glaube ich mit "TableOfContents" gemacht werden!? Oder irre ich mich bei beidem Total?
Ich hoffe unter euch sind ein paar die sich mit dem Export nach Word besonders gut auskennen.
Hier der Code zum Exportieren der Dokumente:
Sub Click(Source As Button)
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim col As NotesDocumentCollection
Dim Ins As Variant
Set db = session.CurrentDatabase
Set col = db.UnprocessedDocuments
Set WordApp = CreateObject("Word.Application")
Call WordApp.documents.add("c:\Word.dot")
Set WordDoc = WordApp.activedocument
Set Ins= WordDoc.Paragraphs(WordDoc.Paragraphs.Count).Range
Set doc = col.GetFirstDocument
Do Until doc Is Nothing
Set uidoc = workspace.EditDocument(True, doc)
uidoc.EditMode = True
uidoc.AutoReload = False
WordDoc.Paragraphs(WordDoc.Paragraphs.Count).Style = wdStyleHeading3 <------------- Eigentlcih müsste das doch mit dieser Zeiel klappen oder?
Call Ins.InsertAfter("TEXT: "+doc.TEST(0)+Chr$(10))
Call WordDoc.ParagraphFormat.Style("Standard")
Call uidoc.GotoField("Text")
Call uidoc.SelectAll
Call uidoc.Copy
If Not Err = 4407 Then
Err = 0
Call Ins.InsertAfter("Text: "+Chr$(10))
Set Past = WordDoc.Content
Call Past.Collapse(wdCollapseEnd)
Call Past.Paste
Call Ins.InsertAfter(Chr$(10))
End If
Call Ins.InsertAfter(Chr$(12))
uidoc.Close(True)
Set doc = col.GetNextDocument(doc)
Loop
Set WordDoc = WordApp.activedocument
End Sub
Schonmal Vielen Dank für eure Hilfe
Gruß Christian T.
[codeWordDoc.Paragraphs(WordDoc.Paragraphs.Count).Style = wdStyleHeading3 ]
Wo setzt du den Wert für Count?
Ich habe das mal so gelöst
Wordapp.Selection.Style = wdStyleNormal
Hast du auch die wd-Konstanten definiert?
z.B.
Const wdStyleNormal = -1
Const wdStyleHeading3 = -4
Axel
Ich weiß nicht genau, wie das geht, aber einen Anhaltspunkt kann das Aufzeichnen eines Makros von der Inhaltsverzeichniserzeugung bieten.
Das sagt mein Makro-Rekorder mit Word 2003:
Sub Inhaltsverzeichnis()
With ActiveDocument
.TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
LowerHeadingLevel:=3, IncludePageNumbers:=True, AddedStyles:="", _
UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
True
.TablesOfContents(1).TabLeader = wdTabLeaderDots
.TablesOfContents.Format = wdIndexIndent
End With
End Sub
Leider sehe ich mich auch nicht direkt in der Lage den Code nach LS zu portieren.
Fraglich ist für mich noch, wie du das Inhaltsverzeichnis dann an die richtige Stelle bekommst... Aber das kommt auf einen Versuch an.
Ich denke das krieg ich schon hin hab mir das auch mal aufgenommen und dann schau ich mal und teste
jetzt habe ich aber direkt wieder 2 fragen....
und zwar
1. wie kriege ich text fett geschrieben? Ich habe folgendes ausprobiert...
Set Ins = WordDoc.Paragraphs(WordDoc.Paragraphs.Count).Range
Ins.Bold = True
Call Ins.InsertAfter("TEXT: ")
Ins.Bold = False
2. Wie kann ich den Text den ich aus einem RichText Feld (Notes) nach word "Paste" nochmal bearbeiten und z.b. da auch ein Format drauflegen?
So Ich habe den Code mehr oder weniger nochmals komplett über den Haufen geworfen. Anbei findet Ihr meinen neuen Code der bis jetzt auch super läuft.
Sub Click(Source As Button)
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim col As NotesDocumentCollection
Dim Ins asVariant
Set db = session.CurrentDatabase
Set col = db.UnprocessedDocuments
On Error Resume Next
Const wdStyleNormal = -1
Const wdStyleHeading3 = -4
Set WordApp = CreateObject("Word.Application")
Call WordApp.documents.add("c:\WORD.dot")
Set WordDoc = WordApp.activedocument
Set Ins = WordApp.Selection
Set doc = col.GetFirstDocument
Do Until doc Is Nothing
Set uidoc = workspace.EditDocument(True, doc)
uidoc.EditMode = True
With Ins
.Style = wdStyleHeading3
.TypeText "TEXT: "
.TypeText doc.TEST(0) + Chr$(10)
.Style = wdStyleNormal
End With
Err = 0
Call uidoc.GotoField("TEXT")
Call uidoc.SelectAll
Call uidoc.Copy
If Not Err = 4407 Then
With Ins
.Font.Bold = True
.TypeText "TEXT: "+ Chr$(10)
.Font.Bold = False
.Paste
End With
End If
Ins.TypeText Chr$(12)
uidoc.Close(True)
Set doc = col.GetNextDocument(doc)
Loop
Set WordDoc = WordApp.activedocument
End Sub
Jetzt bleiben mir immernoch fragen über bzw. aufgaben die ich erledigen möchte.
1. Weiß jemand von euch wie an den Anfang des Dokumentes springen kann mit dem Cursor????
2. Inhaltsverzeichnis erstellen (Krieg ich schon irgendwie selbst hin)
3. Wieder an den anfange des Dokuments springen (siehe 1)
Vielen Dank schonmal
P.S.
Nimmt das Forum noch spenden an? Ihr habt mir schon so oft geholfen, ich will mich revanchieren.
Schreibt mir einfach dazu ne PN
CU
@Klaus(s)
Natürlich liest du nur das wichtigeste was???? ;D ;D ;D
Naj wie dem auch sei Hier die Lösung auf meine eigene Frage
Set Ins = WordApp.Selection
With Ins
.StartOf(wdStory)
.TypeText "Dies ist ein TEst auf der 1. Seite...." + Chr$(12)
End With
SO sry dachte es wär genug input, aber naja jeder kann sich irren....
Also nach meiner ansicht sollte ja der Code
....CODE
Dim rtitem As Variant
Set rtitem = doc.GetFirstItem( "TEST1" )
If ( rtitem.Type = RICHTEXT ) Then
Forall obj In rtitem.EmbeddedObjects
Call obj.ExtractFile( "c:\test\" & obj.Name )
End Forall
End If
....CODE
die Attachments aus dem Feld ("TEST1") als Datei in den Ordner "c:\test" speichern. leider macht der das nicht.
Das Feld ist definitiv ein RichTextFeld und da drin steht text und sind folgende dateitypen hinterlegt:
*.txt
*.doc
*.xls
der debugger zeigt an das der code bis in die kleinste schleife reingeht, jedoch sehe ich auf meiner C Platte keine daten...
Folgender Code (nicht schön) funktioniert !
Sub Click(Source As Button)
Dim rtitem As NotesRichtextItem
Dim doc As NotesDocument
Dim ws As New NotesUIWorkSpace
Dim uidoc As NotesUIDocument
Set uidoc = ws.currentDocument
Set doc = uidoc.document
Set rtitem = doc.GetFirstItem( "rt" )
If ( rtitem.Type = RICHTEXT ) Then
Forall o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
Call o.ExtractFile( "c:\austausch\" & o.Name )
End If
End Forall
End If
End Sub
Deshalb wiederhole ich meine Frage:
Ist das Dokument bereits gespeichert ?
Hier ein Code Ausschnitt
Sub Click(Source As Button)
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim col As NotesDocumentCollection
Dim Ins As Variant
Set db = session.CurrentDatabase
On Error Resume Next
Const wdStyleNormal = -1
Const wdStyleHeading3 = -4
Set WordApp = CreateObject("Word.Application")
Call WordApp.documents.add("c:\TEST.dot")
Set WordDoc = WordApp.activedocument
Set Ins = WordApp.Selection
Dim view As NotesView
Set view = db.GetView("aView")
Set doc = view.GetFirstDocument
Do Until doc Is Nothing
Set uidoc = workspace.EditDocument(True, doc)
uidoc.EditMode = True
uidoc.AutoReload = False
With Ins
.Style = wdStyleHeading3
.TypeText "TEST1: "
.TypeText doc.TEST1(0) + Chr$(10)
.Style = wdStyleNormal
End With
Dim rtitem As NotesRichTextItem
'...set value of doc...
Set rtitem = doc.GetFirstItem( "FELD" )
If ( rtitem.Type = RICHTEXT ) Then
Forall obj In rtitem.EmbeddedObjects
Messagebox(Cstr(obj.Name))
Call obj.ExtractFile( "c:\test\" & obj.Name )
End Forall
End If
Err = 0
Call uidoc.GotoField("FELD")
Call uidoc.SelectAll
Call uidoc.Copy
If Not Err = 4407 Then
With Ins
.Font.Bold = True
.TypeText "FELD: "+ Chr$(10)
.Font.Bold = False
.Paste
.TypeText Chr$(10) + Chr$(10)
End With
End If
Ins.TypeText Chr$(12)
uidoc.Close(True)
Set doc = view.GetNextDocument(doc)
Loop
WordApp.Documents(1).saveas(flag3)
End Sub
also im debugger geht die "Aktive Zeile" auf die Messagebox, jedoch wird diese nicht angezeigt....
HI Leute
Schande auf mein Haupt.....
Bei dem Errorhandling welches jetzt drin ist kann auch kein fehler kommen.
So nachdem ich das Errorhandling einmal etwas geändert habe, bekomme ich folgende Fehlermeldungen:
Type mismatch
FOR loop not initializied
Hier nochmal der Code
Dim rtitem As NotesRichTextItem
'...set value of doc...
Set rtitem = doc.GetFirstItem( "TEXT" )
If ( rtitem.Type = RICHTEXT ) Then
Forall obj In rtitem.EmbeddedObjects
Messagebox(Cstr(obj.Name))
Call obj.ExtractFile( "c:\test\" & obj.Name )
End Forall
End If
Vielleciht könnt Ihr mir jetzt besser helfen
Ich habe mir mal eine Funktion gebastelt mit der man abfragen kann, ob das Dokument überhaupt Anhänge beinhaltet.
Function xHasDocAttachments(doc As NotesDocument) As Integer
Dim vEval As Variant
vEval = Evaluate("@Attachments", doc)
If vEval(0) = 0 Then
xHasDocAttachments = False
Else
xHasDocAttachments = True
End If
End Function
Axel
So müsste eignetlich jetzt soweit alles laufen, jedoch habe ich jetzt beim feintuning ein kleines Problem....
Und zwar starte ich mein Word Export mit einer Wordvorlage
Call WordApp.documents.add("c:\WORD.dot")
Kann ich die Datei irgendwie in die Datenbank selbst hinterlegen und abrufen oder kann ich einfahc nachfragne ob die Datei in dem Pfad liegt der angegeben wurde und dann dementsprechend eine Fehlermeldung und eine erneute Eingabeaufforderung starten?
Die Sachen mit dem hinterlegen der Datei wäre mir das liebste.... Kann mir da wer helfen?
VIELEN DANK
So liebe Notesgötter,
jetzt abe ich nochmal ne Frage und ich hoffe ihr könnt mir erneut so gut mit rat beiseite stehen.
Es geht darum dass ich für eine Funktion 2 Datein innerhalb der DB brauche. Ich habe die beiden Datein in ein Profildokument gespeichert, kann aber nur eine ein Feld ansprechen, das eine wird immer als leer angezeigt...
Vielen DANK
Dim RTVorlage As NotesRichTextItem
Dim RTF1 As NotesRichTextItem
Dim RTF2 As NotesRichTextItem
Dim NP As String
Dim Dat1 As String
Dim Dat2 As String
Dim ProfDoc As Variant
Set ProfDoc = db.GetProfileDocument("mProf")
Set RTF1= ProfDoc.getFirstitem("Dat1")
Set RTF2= ProfDoc.getFirstItem("Dat2")
NP = session.GetEnvironmentString("Directory",True)
Forall D1 In Dat1.EmbeddedObjects
Call D1.ExtractFile( NP& "\" & D1.source)
Dat1 = cstr(D1.source)
End Forall
Forall D2 In Dat2.EmbeddedObjects
Call D2.ExtractFile( NP& "\" & D2.source)
Dat2 = cstr(D2.source)
End Forall