Eliminierung von Zeilenumbrüchen, Spaces usw.

[HeiCore]

Hi!

Wie bringe ich die Eliminierung von Zeilenumbrüchen, Spaces usw. für meinen Excel-Export zustande?

Kann ich RichText-Felder exportieren in csv?

Danke mal wieder für die Hilfe.

[koehlerbv]

Wie willst Du denn den Export überhaupt machen ? Davon hängt 'ne Menge ab !
Rich Text und CSV beisst sich ja wohl genauso wie VW Käfer und Formel 1 (oder Notes und Drucken ;-)
U.U. kannst Du aber den puren Textanteil von RT extrahieren.

Sag mal genaueres (und Deinen Kenntnisstand).

Bernhard

[HeiCore]

Mein Kenntnisstand ist gleich NULLKOMMANIX!

In einer DB gibt es RichText-Felder, die eigentlich nur Text enthalten.

Diese und reine Textfelder exportiere ich in eine csv-Datei.

Nur wenn ich die RichText-Felder mit exportiere, verschieben sich munter meine Ausgabezeilen.

Ich kann nicht genau sagen, was in den Feldern drinn ist, weil es Abschnittsberechtigungen gibt. (Wo ich nicht berechtigt bin)

Eigentlich auch nur Plain-Text.

[koehlerbv]

Nochmal: WIE exportierst Du ? Bist Du Dir sicher, überhaupt RTFs zu exportieren ? Mit Nullkommanix-Ahnung ?

[HeiCore]

Hi!

Hier der Code:


'Variable deklarieren
   Dim Session As New NotesSession
   
   Dim db As New NotesDatabase("","")
   Dim View As NotesView
   Dim Doc As NotesDocument
   Dim richText As NotesRichTextItem
   Dim embObject As NotesEmbeddedObject
   ' Dim Ersteller As NotesItem
   
   
   
   'Konstante festlegen
   'Exportdatei$ = "c:\Tadei.CSV"
   Exportdatei$ = "c:\Export_SSS_" & Date &".csv"
   'Mail_Adresse_SSS$ = "Frauke@Pan.de"   
   Mail_Adresse_SSS$ = "Peter@Pan.de"   
   Server_Pfad$ ="/!!!!!!!!"
   Name_Exportdb$ = "projekte-hjj\MMAM.nsf"
   
   'Datenbank öffnen
   Call db.open(Server_Pfad$,Name_Exportdb$)
   
   'Variable initialisieren   
   Set View = db.GetView("Export-HDW")
   Set Doc = view.GetFirstDocument
   
   
   'Liefert die nächste freie Referenznummer für eine zu öffnende Datei
   DN% = Freefile
   
   'Exportdatei öffnen
   Open Exportdatei$ For Output Access Write As #DN%
   
   'Überschriftzeile ausgeben   
   Print #DN%,  "Smerv,Baunr,Art,Liste,Adatum,Ename,Eabtlg,ZKabtlg,Zkname,Zfkst,Zfabtlg,Zfname,Anlage,Ktr,Beschreibung,Znr,ESNr,Bgrp,Erl_bis,Vb,Gew,Bemerkung,K_bemerk,Ke,F_bemerk,Fe"    
   
   'Ausgabe in Statuszeile
   Print "Dokumente exportieren"
   
   
   Do While Not (Doc Is Nothing)
      
      success = doc.ComputeWithForm( False, False )
      
      subj = doc.GetItemValue( "Smerv" )
      Werft$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Auftrag" )
      Select Case subj(0)
      Case "51318" : Baunr$ = "318"
      Case "51514" : Baunr$ = "319"
      Case "51320" : Baunr$ = "320"
      Case "51515" : Baunr$ = "321"
      Case "51365" : Baunr$ = "365"
      Case "51533" : Baunr$ = "366"
      Case "51534" : Baunr$ = "367"
      Case Else    : Baunr$ = "Nicht bekannt"
      End Select
      
      'Baunr$ = Trim(subj( 0 ) )   
      
      subj = doc.GetItemValue( "DocNumber" )
      Art$ = Left(subj( 0 ),2 )
      subj = doc.GetItemValue( "DocNumber" )
      Nummer$ = Right$(Trim(subj( 0 )),4 )
      subj = doc.GetItemValue( "Erstellungsdatum" )
      Adatum$ = Format(Date,subj( 0 ) )
      Call View.Refresh
      subj = doc.GetItemValue( "RP_Ersteller_CN" )
      Ename$=subj(0)
      'If Trim(subj(0))<>""Then      
      '   dummy=Instr(subj(0),"/OU=")-4
      '   dummy2=Mid(subj(0),4,dummy)
      '   Ename$ = dummy2   
      'Else
      '   ename$=""
      'End If
      Call View.Refresh
      subj = doc.GetItemValue("RP_Ersteller_Abtlg")
      Eabtlg$ = Trim(subj( 0 ) )
      subj = doc.GetItemValue( "Abt_Konstruktion" )
      ZKabtlg$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Name_Konstruktion_CN" )
      ZKname$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Kst_Fertigung" )
      Zfkst$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Abt_Fertigung" )
      Zfabtlg$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Name_Fertigung_CN" )
      Zfname$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Anlage_Leistung_Fulltrim" )
      Anlage = Fulltrim(subj( 0 ) )   
      subj = doc.GetItemValue( "Auftrag_Meldung_Fulltrim" )
      Ktr$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "body_Fulltrim" )
      Sachverhalt = Fulltrim(subj( 0 ) )
      subj = doc.GetItemValue( "Prüfspez" )
      Znr$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "ESNr" )
      ESNr$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Baugruppe" )
      Bgrp$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Zu_erledigen_bis" )
      Erl_bis$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Vorstellbereit" )
      Vb$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Gewichtung" )
      Gew$ = Trim(subj( 0 ) )   
      subj = doc.GetItemValue( "Bem_QS" )
      Bemerkung$ = Trim(subj( 0 ) )   
      
      'Dokumentdaten ausgeben
      Print #DN%,  Smerv$ & "," & Baunr$ & ","  & Art$ & ","  & Nummer$ & "," & Adatum$ & "," & Ename$ & "," & Eabtlg$ & "," & ZKabtlg$ & "," & Zkname$ & "," & Zfkst$ & "," & Zfabtlg$ & "," & Zfname$ & "," & Anlage & "," & Ktr$ & "," & Sachverhalt & "," & Znr$ & "," & ESNr$ & "," & Bgrp$ & "," & Erl_bis$ & "," & Vb$ & "," & Gew$ & "," & Bemerkung$
      
      ' Call doc.Save( False, True )
      
      'Nächstes Dokument wählen
      Set Doc = view.GetNextDocument(Doc)
      
   Loop
   
   
   'Übergabedatei schließen
   Close #DN%
   
   'Datenbank, in der das Skript läuft
   Set db = Session.CurrentDatabase
   
   'Document erzeugen (für Mail)
   Set doc = db.createDocument
   
   'Formularnamen setzen
   doc.Form="Memo"
   
   'Felder setzen
   doc.subject="Mängelliste / TNSW / Stand : " & Date
   doc.SendTo = Mail_Adresse_HDW$
   doc.Body = |Sehr geehrte Damen und Herren,

anbei erhalten Sie die ....... der ........GmbH.

Mit freundlichem Gruss

- Informationsverarbeitung -

"
|   
   'Anlegen eines RichTextItems / Aufnahme Dateianhang
   Set richText = New NotesRichTextItem(doc,"Anhang")
   
   'Dateianhang zuweisen   
   Set embObject = richText.EmbedObject(EMBED_ATTACHMENT,"", Exportdatei$)
   
   'Mail senden
   doc.send False
   
   'Exportdatei löschen
   Kill Exportdatei$

[koehlerbv]

Okay, wenn unter Deinen Feldern wirklich ein RTitem ist, dann holt Dir ja GetItemValue bereits den puren Textwert.

Willst Du jetzt unnötige Zeichen wir CR oder Spaces oder was auch immer ausfiltern, mußt Du Dir eine Function schreiben, der Du jeweils die Variablen übergibst und die dann Zeichen für Zeichen den String neu zusammensetzt - ohne die "verbotenen" Zeichen also.
Statt
subj = doc.GetItemValue( "Prüfspez" )
Znr$ = Trim(subj( 0 ) )
also
Zn$ = EleminateForbiddenChars (doc.getItemValue ("Prüfspez"), chr$ (10) & chr$ (13) & " " & "|")

wobei EleminateForbiddenChars Deine Function ist, der Du als zweiten Parameter Deine "verbotenen" Zeichen übergibst.

HTH,
Bernhard

[ata]

... ich hab mir mal was zusammengebastelt:

Code

Function ReplaceSubstrings(sText As String , sSubstring As Variant , sRepString As Variant) As String
' # ReplaceSubstrings - Anton Tauscher - ata - 06.2002
' # Ersetzt in einem String bestimmte Teilstrings durch neue - 1. String alt gegen 1. String neu
' # ... sText          = der eigentliche Text
' # ... sSubstring   = Array mit Strings, die ersetzt werden sollen - alte Werte
' # ... sRepString   = Array mit Strings, durch die ersetzt wird - neue Werte
   Dim sAlt() As String
   Dim sNeu() As String
   Dim i As Integer
   Dim lbSub As Integer
   Dim ubSub As Integer
   Dim lbRep As Integer
   Dim ubRep As Integer
   Dim sBefore As String
   Dim sAfter As String
   Dim sDummy() As String
   Dim counter As Integer
   
   counter = -1
   If Lbound( sSubString ) <> 0 Then
      For i = Lbound( sSubString ) To Ubound(sSubString)
         counter = counter + 1
         Redim Preserve sDummy( 0 To counter )
         sDummy( counter ) = sSubString( i )
      Next
      sSubString = sDummy
   End If
   counter = -1
   Redim sDummy( 0 To 0 )
   If Lbound( sRepString ) <> 0 Then
      For i = Lbound( sRepString ) To Ubound(sRepString)
         counter = counter + 1
         Redim Preserve sDummy( 0 To counter )
         sDummy( counter ) = sRepString( i )
      Next
      sRepString = sDummy
   End If
   
   ReplaceSubstrings = ""
   
' # 1. Validierung der Parameter
' # ... wurde ein Text übergeben...
   If sText = "" Then
      ' # Es wurde kein Text übergeben - Abbruch
      Exit Function
   End If
' # ... wurden Arrays übergeben...
   If Isempty(sSubstring) Or Isempty(sRepString) Then
' # ... ... es wurden keine Arrays übergeben - Abbruch
      Exit Function
   Else
' # ... ... wenn ja, haben die Arrays die gleiche Anzahl Elemente...
      If Ubound(sSubstring) - Lbound(sSubstring) <> Ubound(sRepString) - Lbound(sRepString) Then
' # ... ... ... die Arrays haben unterschiedlich viele Elemente -. Abbruch
         Exit Function
      Else
' # ... ... ... die Parameter sind überprüft - Weiter...
         lbSub = Lbound(sSubstring)
         ubSub = Ubound(sSubstring)
         lbRep = Lbound(sRepString)
         ubRep = Ubound(sRepString)
      End If
   End If
   
' # 2. Suchen der Teilstrings im Text
   For i = lbSub To ubSub
      Do Until Instr(sText , Cstr(sSubstring(i))) = 0
         sBefore = Left(sText ,  Instr(sText , Cstr(sSubstring(i)))-1 )
         sAfter = Right(sText , Len(stext) - Len(sBefore) - Len(Cstr(sSubstring(i)))  )
         sText = sBefore + sRepString(i) + sAfter
      Loop      
   Next
   ReplaceSubstrings = sText
   
End Function

sSubstring und sRepString sind Arrays mit Strings die ersetzt werden sollen

sSubstring(0) gegen sRepstring(0) usw...

... könnte dir weiterhelfen

ata

[HeiCore]

Hi!

Danke schonmal, aber wie müsste die FUnktion: "EleminateForbiddenChars" aussehen?

Oder wie binde ich die ReplaceSubstring-Variante ein?

[ata]

... du erstellst eine Library und bindest dise mit einer 'Use'-Anweisung in dein Script ein. Nach dem Einbinden der Library kannst du dann die funktion ansprechen.

... zur Not habe ich das in meinem Tutorial auf meiner Homepage im groben beschrieben http://www.anton-tauscher.de/LotusScript

ata