Hallo,
ich habe folgendes Script f�r den Export nach Excel.
Das Rich-Text-Feld Beitrag soll ins Excel ohne Zeilenumb�che exportiert werden. Die Returns habe ich schon duch Blanks ersetzt. Was mu� ich an der marierten Stelle einf�gen?
Please Help!!
Sub Click(Source As Button)
'Daten aus der View
Dim x As Integer
Dim y As Integer
Dim strLen As Integer
Dim ses As NotesUIworkspace
Dim vw As NotesUIView
Dim coldocs As NotesDocumentCollection
Dim doc As NotesDocument
Dim it As Variant
Dim strDesc As String
Dim strTrack As String
Set ses = New NotesUIWorkspace
Set vw = ses.currentview
Set coldocs = vw.documents
Set doc = coldocs.getfirstdocument
'Set up Excel
Dim xlApp As Variant
Dim xlSheet As Variant
Set xlApp = CreateObject("Excel.application")
xlApp.Workbooks.Add
Set xlSheet = xlApp.Workbooks(1).Worksheets(1)
'�berschrift
xlSheet.Cells(1, 1).Value = "Typ"
xlSheet.Cells(1, 2).Value = "Active"
xlSheet.Cells(1, 3).Value = "Anreisser"
xlSheet.Cells(1, 4).Value = "Ansprechpartner"
xlSheet.Cells(1, 5).Value = "Beitrag"
xlSheet.Cells(1, 6).Value = "Datum"
xlSheet.Cells(1, 7).Value = "Title"
xlSheet.Cells(1,
.Value ="Thema01"
xlSheet.Cells(1, 9).Value ="Thema02"
xlSheet.Cells(1, 10).Value ="Thema03"
xlSheet.Cells(1, 11).Value ="Thema04"
xlSheet.Cells(1, 12).Value ="Thema05"
xlSheet.Cells(1, 13).Value ="Thema06"
xlSheet.Cells(1, 14).Value ="Thema07"
xlSheet.Cells(1, 15).Value ="Thema08"
xlSheet.Cells(1, 16).Value ="Thema09"
xlSheet.Cells(1, 17).Value ="Thema10"
xlSheet.Cells(1, 18).Value ="TopStory"
'Feder formatieren
xlSheet.Columns(1).Columnwidth = 10
xlSheet.Columns(2).Columnwidth = 10
xlSheet.Columns(3).Columnwidth = 10
xlSheet.Columns(4).Columnwidth = 10
xlSheet.Columns(5).Columnwidth = 10
xlSheet.Columns(6).Columnwidth = 10
xlSheet.Columns(7).Columnwidth = 10
xlSheet.Columns(
.Columnwidth = 10
xlSheet.Columns(9).Columnwidth = 10
xlSheet.Columns(10).Columnwidth = 10
xlSheet.Columns(11).Columnwidth = 10
xlSheet.Columns(12).Columnwidth = 10
xlSheet.Columns(13).Columnwidth = 10
xlSheet.Columns(14).Columnwidth = 10
xlSheet.Columns(15).Columnwidth = 10
xlSheet.Columns(16).Columnwidth = 10
xlSheet.Columns(17).Columnwidth = 10
xlSheet.Columns(18).Columnwidth = 10
'xlSheet.Columns(
.Wraptext = True
xlSheet.Columns(1).VerticalAlignment = 1
xlSheet.Columns(2).VerticalAlignment = 1
xlSheet.Columns(3).VerticalAlignment = 1
xlSheet.Columns(4).VerticalAlignment = 1
xlSheet.Columns(5).VerticalAlignment = 1
xlSheet.Columns(6).VerticalAlignment = 1
xlSheet.Columns(7).VerticalAlignment = 1
xlSheet.Columns(
.VerticalAlignment = 1
xlSheet.Columns(9).VerticalAlignment = 1
xlSheet.Columns(10).VerticalAlignment = 1
xlSheet.Columns(11).VerticalAlignment = 1
xlSheet.Columns(12).VerticalAlignment = 1
xlSheet.Columns(13).VerticalAlignment = 1
xlSheet.Columns(14).VerticalAlignment = 1
xlSheet.Columns(15).VerticalAlignment = 1
xlSheet.Columns(16).VerticalAlignment = 1
xlSheet.Columns(17).VerticalAlignment = 1
xlSheet.Columns(18).VerticalAlignment = 1
xlSheet.PageSetup.Orientation = 2
'�berschrift unterstreichen
xlsheet.Cells(1, 1).Font.Underline = 2
xlsheet.Cells(1, 2).Font.Underline = 2
xlsheet.Cells(1, 3).Font.Underline = 2
xlsheet.Cells(1, 4).Font.Underline = 2
xlsheet.Cells(1, 5).Font.Underline = 2
xlsheet.Cells(1, 6).Font.Underline = 2
xlsheet.Cells(1, 7).Font.Underline = 2
xlsheet.Cells(1,
.Font.Underline = 2
xlsheet.Cells(1, 9).Font.Underline = 2
xlsheet.Cells(1, 10).Font.Underline = 2
xlsheet.Cells(1, 11).Font.Underline = 2
xlsheet.Cells(1, 12).Font.Underline = 2
xlsheet.Cells(1, 13).Font.Underline = 2
xlsheet.Cells(1, 14).Font.Underline = 2
xlsheet.Cells(1, 15).Font.Underline = 2
xlsheet.Cells(1, 16).Font.Underline = 2
xlsheet.Cells(1, 17).Font.Underline = 2
xlsheet.Cells(1, 18).Font.Underline = 2
xlsheet.PageSetup.PrintTitleRows = "$1:$1"
xlsheet.PageSetup.Zoom = 80
For x = 3 To (coldocs.count + 2)
xlSheet.Cells(x, 1).Value = doc.Typ
xlSheet.Cells(x, 2).Value = doc.Active
xlSheet.Cells(x, 3).Value = doc.Anreisser
xlSheet.Cells(x, 4).Value = doc.Ansprechpartner
'xlSheet.Cells(x, 6).Value = doc.BeitragRTF
'----------------------------------------------------------------------------------------------------------------------
'
Hier ist der Teil Wo ich alle Zeilenumbr�che raus haben m�chte
Set it = doc.getfirstitem("BeitragRTF")
strDesc = it.text
' alle returns raus
strLen = Len(strDesc)
For y = 1 To strLen
If Mid(strDesc, y, 1) = Chr(13) Then
Mid(strDesc,y,1)= " "
End If
Next
' modifizierter Inhalt ins Excelfeld
xlSheet.Cells(x, 5).Value = strDesc '-----------------------------------------------------------------------------------------------------------------------------------
xlSheet.Cells(x, 6).Value = doc.Datum
xlSheet.Cells(x, 7).Value = doc.Titel
xlSheet.Cells(x,
.Value = doc.Thema01
xlSheet.Cells(x, 9).Value = doc.Thema02
xlSheet.Cells(x, 10).Value = doc.Thema03
xlSheet.Cells(x, 11).Value = doc.Thema04
xlSheet.Cells(x, 12).Value = doc.Thema05
xlSheet.Cells(x, 13).Value = doc.Thema06
xlSheet.Cells(x, 14).Value = doc.Thema07
xlSheet.Cells(x, 15).Value = doc.Thema08
xlSheet.Cells(x, 16).Value = doc.Thema09
xlSheet.Cells(x, 17).Value = doc.Thema10
xlSheet.Cells(x, 18).Value = doc.TopStory
Set doc = coldocs.GetNextDocument(doc)
Next x
Msgbox "Fertig!", 64, "Excel Export"
'Excel wird angeziegt
xlApp.Visible = True
End Sub
Gruß
Hitcher
