Domino 9 und frühere Versionen > Entwicklung

Rich Text Feld zu klein??

<< < (3/3)

Glombi:
Kannst Du uns mal etwas mehr Code spendieren?

Wie wird "rlTransaction_description" gesetzt?

Andreas

chriss76:
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

Glombi:
Das ganze müsste so aussehen:

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
      
      Dim rtitem As NotesRichTextItem
         
      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)
               
               Set rtitem = New NotesRichTextItem( nd, "rlTransaction_description")
               Call rtitem.AppendText(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 rtitem.AddNewLine(1)
                  Call rtitem.AppendText(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 = ""                  
                  
                  
                  '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
                  
                  
                  
                  '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

chriss76:
Moin,

ich habe das letzte Coding eingebaut, aber leider wird der Upload dadurch so langsam, dass ich ihn nicht gebrauchen kann.
Ich habe den Rechner die ganze Nacht laufen lassen und er hat gerade mal 6000 von 30000 Sätzen eingelesen und ich weiss nicht warum es so lange gedauert hat.
Am Anfang startet er flott, wird dann aber zusehendest langsamer!

Hat jemand noch eine Idee?

Chris

Navigation

[0] Themen-Index

[*] Vorherige Sete

Zur normalen Ansicht wechseln