Hallo Andreas,
rlTransaction_description ist der Name eines Feldes in der Maske!
Anbei die ganze Routine!
Sub ExcelUpload_roleinformation()
On Error Goto ErrorHandler
Dim strWert As String
strWert=Msgbox("Would you like to upload an Excel sheet ==> role information, -details?", 1, "Attention! Data will be changed!")
If strWert = 2 Then
Exit Sub
End If
Dim strPath As String
strPath=Inputbox$("Path of Excel file","Excel Upload","C:\P13_rollen_information_test.xls")
If strPath<>"" Then
'Initiate Excel
Dim xlApp As Variant
Dim xlWorkbook As Variant
Set xlApp=CreateObject("excel.application")
xlApp.Visible=True
Set xlWorkbook=xlApp.Workbooks.Open(strPath)
'Initialize
Dim ns As New NotesSession
Dim ndb As notesDatabase
Set ndb=ns.CurrentDatabase
Dim counter As Long
Dim strRole As String
Dim strDesc As String
Dim strDatestart As String
Dim strDateend As String
Dim strTransaction As String
Dim strTransactionDesc As String
Dim strOwner As String
Dim strStandin As String
Dim nd As NotesDocument
Dim ni As NotesItem
'neue Zeile
Dim rtitem As Variant
counter=1
Dim help_role As String
help_role = ""
With xlWorkbook.Worksheets(1)
Do While .Range("A" + Cstr(counter)).Value <>""
strRole = ""
strDesc=""
strTransaction=""
strTransactionDesc=""
'Daten werden zeilenweise aus dem Excelfile ausgelesen
strRole=.Range("A" + Cstr(counter)).Value
strDesc=.Range("B" + Cstr(counter)).Value
strTransaction=.Range("C" + Cstr(counter)).Value
strTransactionDesc=.Range("D" + Cstr)(counter)).Value
'Wenn es das erste Dokument ist, dann wird auch der Vergleichswert
'help_role gefüllt. Dieser wird benötigt, um zu vergleichen, ob 2
'aufeinander folgende Rolle gleich sind.
'das kann ja beim ersten Dokument nicht der Fall sein
If counter = 1 Then
help_role = strRole
Set nd=ndb.CreateDocument()
Call nd.ReplaceItemValue("Form","fa_Role_info")
Set ni=nd.ReplaceItemValue("AccessAdmin","[Admin]")
ni.IsAuthors=True
strTransactionDesc = strTransaction + " " + strTransactionDesc
Call nd.ReplaceItemValue("rlTitle",strRole)
Call nd.ReplaceItemValue("rlComment",strDesc)
'Call nd.ReplaceItemValue("rlDatestart",strDatestart)
'Call nd.ReplaceItemValue("rlDateend",strDateend)
Call nd.ReplaceItemValue("rlTransaction_description",strTransactionDesc)
'Call nd.ReplaceItemValue("rlOwner",strOwner)
'Call nd.ReplaceItemValue("rlStandin",strStandin)
Call nd.Save(True,True)
Else
'ab hier wenn läuft die Schleife, wenn es nicht das erste Dokument ist
If strRole <> help_role Then
' wenn die akuelle Rolle nicht mit der davorgehenden Rolle übereinstimmt,
' dann wird einfach ein neues Dokument angelegt und der Wert von help_role
' wird durch den gerade aktuellen Wert überschrieben
Set nd=ndb.CreateDocument()
Call nd.ReplaceItemValue("Form","fa_Role_info")
Set ni=nd.ReplaceItemValue("AccessAdmin","[Admin]")
ni.IsAuthors=True
strTransactionDesc = strTransaction + " " + strTransactionDesc
Call nd.ReplaceItemValue("rlTitle",strRole)
Call nd.ReplaceItemValue("rlComment",strDesc)
'Call nd.ReplaceItemValue("rlDatestart",strDatestart)
'Call nd.ReplaceItemValue("rlDateend",strDateend)
Call nd.ReplaceItemValue("rlTransaction_description",strTransactionDesc)
'Call nd.ReplaceItemValue("rlOwner",strOwner)
'Call nd.ReplaceItemValue("rlStandin",strStandin)
Call nd.Save(True,True)
help_role = strRole
Elseif strRole = help_role Then
'wenn die aktuelle Rolle mit der davorgehenden Rolle übereinstimmt
Dim help_strTransactionDesc As String
help_strTransactionDesc = ""
Set rtitem = nd.GetFirstItem( "rlTransaction_description" )
'Get description from the existing document
'alle Dokumente müssen sortiert vorliegen
'help_strTransactionDesc = nd.rlTransaction_description(0)
'im gerade aktuellen Dokument werden die Transaktion und
'die Transaktionsbeschreibung zusammen gefügt
strTransactionDesc = strTransaction + " " + strTransactionDesc
'die Transaktion und die Beschreibung werden mit einem Return an
'die bereits bestehenden Daten angehängt
'strTransactionDesc = help_strTransactionDesc + Chr$(10) + strTransactionDesc
If ( rtitem.Type = RICHTEXT ) Then
'...use NotesRichTextItem methods...
Call rtitem.AddNewLine(1)
Call rtitem.AppendText(strTransactionDesc)
End If
Call rtitem.AddNewLine(1)
Call rtitem.AppendText(strTransactionDesc)
'Anhängen des Strings
'Call nd.ReplaceItemValue("rlTransaction_description",strTransactionDesc)
Call nd.Save(True,True)
End If
End If
'Counter für Excelzeile wird um 1 erhöht
counter=counter+1
Loop
End With
'Schliessen von Excel
Call xlApp.Quit
End If
ExitSub:
Exit Sub
ErrorHandler:
Msgbox Cstr(Err) + " -" + "BaseFunctionsLib\ExcelUpload_roleinformation: " + Error$ + ", Excel Line: "+ Cstr(counter), 16, "Error"
Goto ExitSub
End Sub
