Domino 9 und frühere Versionen > Entwicklung

Kalendereintrag schon da?

<< < (4/4)

ata:
... ich habe den Code nicht bis ins letzte getestet...
... es werden neue Kalendereinträge erstellt, wenn noch keine zu dieser Person eingetragen waren...


--- Zitat ---' # Code kann in einer Aktion oder Schaltfläche verwendet werden...
' # ... Import von Geburtstagsterminen aus einer Textdatei...
' # ... Abgleich, ob ein Kalendereintrag bereits existiert,
' # ... wenn nicht, dann wird ein neuer Eintrag erstellt - ata - 04.2003
   
   Dim session As New NotesSession               ' # Wird zur initialisierung der Mail-DB benötigt
   Dim dbMail As NotesDatabase                      ' # ... die Datenbank mit den Terminen
   Dim vMailDB As Variant                           ' # ... Parameteraufahme
   Dim sSearch As  String                           ' # ... für die Suchformel
   Dim sdt As New NotesDateTime( "01/01/1990" )   ' # ... Dokumente ab diesem Datum werden gesucht
   Dim dc As NotesDocumentCollection               ' # ... alle Geburtstagseinträge in der Datenbank
   Dim doc As NotesDocument                     ' # ... bestehnder Geburtstagseintrag
   Dim docNew As NotesDocument                  ' # ... neuer Geburtstagseintrag
   Dim i As Integer                                 ' # ... Laufvariable
   Dim found As Variant                           ' # ... = True = Kalendereintrag gefunden
   Dim fileNum As Integer                           ' # ... Dateinummer - wird zum identifizieren der Importdatei benötigt
   Dim counter As Integer                           ' # .. Zählervariable
   Dim Zeile() As String                              ' # ... Array mit den eingelesenen Werten ( Grenzen bei 64K Index )
   Dim sSubject As String                           ' # ... der Betreff des Kalendereintrages - Geburtstag: Name
   Dim CalDate As NotesDateTime                  ' # ... Datum für Kalendereintrag
   Dim item As NotesItem                           ' # ... um ein Feld zu Datumsfeld zu konvertieren
   
   fileNum = Freefile()                              ' # ... der Importdatei eine Nummer vergeben
   counter = 0                                       ' # ... Zählervariable auf Null setzen
   Open "D:\Geburtstage.txt" For Input As fileNum   ' # Textdatei zum Lesen öffnen - ### Pfad korrigieren !!! ###
   Do While Not Eof(fileNum)                        ' # ... bis zum Ende der Textdatei...
      Redim Preserve Zeile(0 To counter )            ' # ... ... das Array um ein Element erweitern
      Line Input #fileNum, Zeile( counter )            ' # ... ... eine Zeile in das Array übernehmen
      counter = counter + 1                         ' # ... ... weiterzählen
   Loop                                             ' # ... wiederholen bis Ende der Textdatei erreicht
   Close fileNum
   Print Cstr(counter) + " Einträge gefunden"
      
      vMailDB = Evaluate("@MailDBName")               ' # Parameter der Maildatenbank des Users
      Set dbMail = session.GetDatabase( vMailDB(0) , vMailDB(1) ) ' # ... Maildatenbank initialisieren - Parameter eventuell anpassen
      If dbMail.IsOpen Then                           ' # ... wenn die Mail-DB geöffnet werden konnte...
         sSearch = |SELECT Form = "Appointment" & @Left( Subject ; 10 ) = "Geburtstag" | ' # ... Suchformel bilden
         Set dc = dbMail.Search( sSearch , sdt , 0)       ' # ... alle Geburtstagseinträge
         Print Cstr( dc.Count ) + " Einträge gefunden..."
         For i = 0 To counter - 1                        ' # Abarbeiten der eingelesenen Daten des Arrays
            sSubject = Mid( Zeile( i ) , 12 , Len( Zeile(i)) -11) ' # ... den gesuchten Betreffeintrag aus der Textdatei isolieren
            Print sKey + " - " sSubject                  ' # ... Kontrollausgabe für Debugging
            If dc.Count > 0 Then                        ' # ... wenn Kalendereinträge gefunden wurden
               found = False                           ' # ... zurücksetzen der flag
               Set doc = dc.GetFirstDocument         ' # ... den ersten Kalendereintrag initialisieren
               While Not doc Is Nothing                  ' # ... alle Kalendereinträge...         
                  If  Trim( doc.Subject(0) ) = Trim( sSubject ) Then   ' # ... ... wenn es ein Geburtstagseintrag ist, dann            
                     found = True                     ' # ... ... flag auf True setzen
                     Goto IsFound                     ' # ... ... keine weitere Suche notwendig - springe zu IsFound
                  End If
                  Set doc = dc.GetNextDocument(doc)   ' # ... ... ächsten Kalendereintag, solange noch nicht gefunden
               Wend                                 ' # ... alle Kalendereinträge sind abgearbeitet
IsFound:
               If found Then                            ' # Sollte der Eintrag gefunden worden sein, dann...
                  Print "Gefunden: " + sSubject          ' # ... ... Kontrollausgabe für Debugging
               Else                                    ' # ... ansonsten
                  Goto Neuanlage                     ' # ... Geburtstagseintrag nicht gefunden => Neuanlage eines Dokumentes
               End If
            Else                                       ' # ... keine Kalendereinträge mit "Geburtstag" gefunden, bzw. Neuanlage
Neuanlage:
               Print "Neuanlage: " + sSubject             ' # ... Kontrollausgabe für Debugging
               Set docNew = dbMail.CreateDocument    ' # Neues Dokument in der Mail-DB erstellen
               docNew.Form = "Appointment"                                 ' # ... Termineintrag
               docNew.AppointmentType = "1"                                 ' # ... Jahrestag
               Set calDate = New NotesDateTime( Left(Zeile( i ) , 10 ) + " 07:00:00"  )
               Set item = New NotesItem( docNew , "CalendarDateTime" , calDate.LsLocalTime)
               item.IsSummary = True
               Set calDate = New NotesDateTime( Left(Zeile( i ) , 10 ) + " 23:59:59"  )
               Set item = New NotesItem( docNew , "EndDateTime" , calDate.LsLocalTime)
               item.IsSummary = True
               Call docNew.ReplaceItemValue("$CSVersion" , "2")
               Call docNew.ReplaceItemValue("Subject" , sSubject)             ' # ... Betreff des Termines
               Call docNew.ReplaceItemValue("_ViewIcon" , 63)                ' # ... Appointment-Icon für gleiches Display
               Call docNew.ReplaceItemValue("$Alarm" , "1")                   ' # ... Alarm einschalten
               Call docNew.ReplaceItemValue("$AlarmDescription" , sSubject )   ' # ... Alarminhalt
               Call docNew.ReplaceItemValue("$AlarmOffset" , -1440 * 1 )       ' # ... 1 = einen Tag davor benachrichtigen
               Call docNew.Save( True , True )         ' # Kalendereintrag in der Mail-DB speichern
            End If
         Next
         Print "Import der Geburtstage abgeschlossen."
      Else
         Print "Maildatenbank konnte nicht geöffnet werden." ' # ... Kontrollmeldung: Kein Import möglich - nur zur Absicherung
      End If   
--- Ende Zitat ---

... ich denke das war was du brauchst,
... ich hab' es ausfühlich kommentiert...

ata

Navigation

[0] Themen-Index

[*] Vorherige Sete

Zur normalen Ansicht wechseln