Seite drucken - Per VBA Meeting in Notes Kalender eintragen und Einladungen senden

Titel: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: etofi am 18.02.11 - 14:54:27

Hallo zusammen,

ich bin am verzweifeln. Ich möhte per VBA eine Meeting im Notes Kalender anlegen.
Das geht auch ganz gut, nur die Funktion "Status der eingeladenen Personen anzeigen" geht nicht.
Es kommt immer die Fehlermeldung "Object variable not set".

Anbei mein Code

Code

Public Function SendNotesTermin(pstrSubject As String, _
                                pstrRecipient As String, _
                                pstrMailBody As String, _
                                AppDate As Date, _
                                StartTime As Date, _
                                MinsDuration As Integer, _
                                pstrLocation As String, _
                                pstrCategories As String, _
                                AppointmentType As String) As String
                              

'Aufgabe:   Sendet Termine mit Attachment via Notes
'Rückgabe:  String mit Fehlermeldung bei auftretendem Fehler, sonst Leerstring
'
'WICHTIG:   Bei den Empfängern darf der Absender nicht enthalten sein!!


    On Error GoTo proc_error

    Dim objMaildb           As Object
    Dim objCalenDoc         As Object
    Dim strMailDbName       As String
    Dim strUserName         As String
    Dim strServerName       As String
    Dim varEmpfListe()      As Variant
    Dim datStartDatum       As Date
    Dim datStartZeit        As Date
    Dim datEndDatum         As Date
    Dim datEndZeit          As Date
    
    
    SendNotesTermin = ""
    
    'Zeitvariablen füllem
    datStartDatum = DateSerial(Year(AppDate), Month(AppDate), Day(AppDate))
    datStartZeit = TimeSerial(Hour(StartTime), Minute(StartTime), Second(StartTime))
    datEndDatum = DateSerial(Year(DateAdd("n", MinsDuration, AppDate)), Month(DateAdd("n", MinsDuration, AppDate)), Day(DateAdd("n", MinsDuration, AppDate)))
    datEndZeit = TimeSerial(Hour(DateAdd("n", MinsDuration, StartTime)), Minute(DateAdd("n", MinsDuration, StartTime)), Second(DateAdd("n", MinsDuration, StartTime)))
    
    
    'Empfänger, per Komma getrennt, in Empfängerarray eingelesen
    intEmpfCnt = 0
    lngPos1 = InStr(1, pstrRecipient, ",")
    While lngPos1 > 0
        ReDim Preserve varEmpfListe(intEmpfCnt)
        varEmpfListe(intEmpfCnt) = Left(pstrRecipient, lngPos1 - 1)
        pstrRecipient = Right(pstrRecipient, Len(pstrRecipient) - lngPos1)
        lngPos1 = InStr(1, pstrRecipient, ",")
        intEmpfCnt = intEmpfCnt + 1
    Wend
    ReDim Preserve varEmpfListe(intEmpfCnt)
    varEmpfListe(intEmpfCnt) = pstrRecipient
    
        
    'Notes befüllen
    Set objSession = CreateObject("Notes.NotesSession")
    
    strUserName = objSession.UserName
    strServerName = objSession.GETENVIRONMENTSTRING("MailServer", True)
    strMailDbName = objSession.GETENVIRONMENTSTRING("MailFile", True)
    
    Set objMaildb = objSession.GETDATABASE(strServerName, strMailDbName)
       
    If objMaildb.ISOPEN <> True Then
        On Error Resume Next
        objMaildb.OPENMAIL
    End If
      
    Set objCalenDoc = objMaildb.CREATEDOCUMENT
    
    With objCalenDoc
        
        .REPLACEITEMVALUE "Form", "Appointment"
        .REPLACEITEMVALUE "AppointmentType", AppointmentType '0=Appointment, 1=Anniversary, 2=AllDayEvent, 3=Meeting, 4=Reminder
        
        'Zeit und Datum
        .REPLACEITEMVALUE "StartDateTime", CDate(datStartDatum & " " & datStartZeit)
        .REPLACEITEMVALUE "CalendarDateTime", CDate(datStartDatum & " " & datStartZeit)
        .REPLACEITEMVALUE "EndDateTime", CDate(datEndDatum & " " & datEndZeit)
        .REPLACEITEMVALUE "StartDate", datStartDatum
        .REPLACEITEMVALUE "StartTime", datStartZeit
        .REPLACEITEMVALUE "EndDate", datEndDatum
        .REPLACEITEMVALUE "EndTime", datEndZeit
        .REPLACEITEMVALUE "$NoPurge", datEndDatum & " " & datEndZeit
                
        'Eigentümer
        .REPLACEITEMVALUE "Chair", strUserName
        .REPLACEITEMVALUE "AltChair", strUserName
        .REPLACEITEMVALUE "From", strUserName
        .REPLACEITEMVALUE "Principal", strUserName
        .REPLACEITEMVALUE "$AltPrincipal", strUserName
        
        'Was, wo und warum
        .REPLACEITEMVALUE "Categories", pstrCategories
        .REPLACEITEMVALUE "Location", pstrLocation
        .REPLACEITEMVALUE "Subject", pstrSubject
        .REPLACEITEMVALUE "Body", pstrMailBody
        
        ' Einstellung einer Erinnerung in Minuten
        .REPLACEITEMVALUE "$Alarm", 1
        .REPLACEITEMVALUE "$AlarmOffset", -15
        .REPLACEITEMVALUE "Alarms", "1"
        
        'Welches Icon soll angezeigt werden
        Select Case AppointmentType
            Case 0 'Appointment
                .REPLACEITEMVALUE "_viewicon", 160
            Case 1 'Anniversary
                .REPLACEITEMVALUE "_viewicon", 63
            Case 2 'AllDayEvent
                .REPLACEITEMVALUE "_viewicon", 9
            Case 3 'Meeting
                .REPLACEITEMVALUE "_viewicon", 158
            Case 4 'Reminder
                .REPLACEITEMVALUE "_viewicon", 10
        End Select
        
        'Notes Systemvariablen
        .REPLACEITEMVALUE "$BorderColor", "D2DCDC"
        .REPLACEITEMVALUE "$BusyName", strUserName
        .REPLACEITEMVALUE "$BusyPriority", "1"
            Dim strCSTrack(2)       As String
            Dim strUserFuerCSTrack  As String
            strUserFuerCSTrack = Replace(strUserName, "CN=", "")
            strUserFuerCSTrack = Replace(strUserFuerCSTrack, "OU=", "")
            strUserFuerCSTrack = Replace(strUserFuerCSTrack, "O=", "")
            strCSTrack(0) = "Send Request by Notes Client on " & strUserFuerCSTrack & "(" & objSession.NOTESVERSION & ") at " & Format(Now(), "dd.mm.yyyy hh:mm:ss")
            strCSTrack(1) = "Prepare Request by Notes Client on " & strUserFuerCSTrack & "(" & objSession.NOTESVERSION & ") at " & Format(Now(), "dd.mm.yyyy hh:mm:ss")
            strCSTrack(2) = "Revert Invitation by Notes Client on " & strUserFuerCSTrack & "(" & objSession.NOTESVERSION & ") at " & Format(Now(), "dd.mm.yyyy hh:mm:ss")
        .REPLACEITEMVALUE "$CSTrack", strCSTrack
        .REPLACEITEMVALUE "$CSVersion", "2"
        .REPLACEITEMVALUE "$CSWISL", Array("$S:1", "$L:1", "$B:1", "$R:1", "$E:1", "$W:1", "$O:1", "$M:1")
        .REPLACEITEMVALUE "$ExpandGroups", "3"
        .REPLACEITEMVALUE "$FromPreferredLanguage", "de"
        .REPLACEITEMVALUE "$HFFlags", "1"
        .REPLACEITEMVALUE "$LangChair", ""
        .REPLACEITEMVALUE "$SMTPKeepNotesItem", "1"
        .REPLACEITEMVALUE "$WatchedItems", Array("$S", "$L", "$B", "$R", "$E", "$W", "$O", "$M")
        .REPLACEITEMVALUE "ApptUNID", .UNIVERSALID
        .REPLACEITEMVALUE "BookFreeTime", ""
        .REPLACEITEMVALUE "ExcludeFromView", Array("S", "D")
        .REPLACEITEMVALUE "MailOptions", "0"
        .REPLACEITEMVALUE "MeetingType", "1"
        .REPLACEITEMVALUE "OrgTable", "C0"
        .REPLACEITEMVALUE "PublicAccess", "1"
        .REPLACEITEMVALUE "Resources", ""
        .REPLACEITEMVALUE "Repeats", ""
        .REPLACEITEMVALUE "RoomToReserve", ""
        .REPLACEITEMVALUE "SchedulerSwitcher", "1"
        .REPLACEITEMVALUE "StartTimeZone", "Z=-1$DO=1$DL=3 -1 1 10 -1 1$ZX=86$ZN=W. Europe"
        .REPLACEITEMVALUE "StorageRequiredNames", "1"
        .REPLACEITEMVALUE "UpdateSeq", 1
        .REPLACEITEMVALUE "WebDateTimeInit", "1"
       
        'Versandeinstellungen
        If AppointmentType = 3 Then 'Meeting
            .REPLACEITEMVALUE "Recipients", varEmpfListe
            .REPLACEITEMVALUE "RequiredAttendees", varEmpfListe
            .REPLACEITEMVALUE "AltRequiredNames", varEmpfListe
            .REPLACEITEMVALUE "SendTo", varEmpfListe
        End If
        '.DeliveryReport = "B"               'Übermittlung anzeigen
        '.Importance = "2"                   'Wichtigkeit hochsetzen
        .SAVEMESSAGEONSEND = False           ' bei True wird ein Exemplar in Notes in Gesendet gestellt
        .SIGNONSEND = True                   'Signieren beim Versand
        '.ReturnReceipt = "1"                'Empfang bestätigen
                     

        'Überprüfen vor dem Speichern bzw. Versand
        If .COMPUTEWITHFORM(True, False) Then
            MsgBox "Bei der Erstellung des Termins ist ein Fehler aufgetreten!"
            GoTo proc_exit
        End If
        
        'Wenn es ein Metting ist, Einladungen versenden
        If AppointmentType = 3 Then
            .SEND 0
        End If
       
       'Im Kalender speichern
       .Save 1, 0
       
       'Damit der Alarm auch funtioniert
       .PUTINFOLDER "$Alarms", True
       
    End With
    
proc_exit:
    Set objMaildb = Nothing
    Set objCalenDoc = Nothing
    Exit Function
    
proc_error:
    SendNotesTermin = Err.Description
    Resume proc_exit
    
End Function

Welche Variable habe ich vergessen? Bin wirklich ratlos...

Grüße
Eric Trösch

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: Peter Klett am 18.02.11 - 17:27:20

Erstelle Dir ein Dokument, wie Du es haben möchtest, manuell. Vergleiche dann über die Felderliste das manuell erstellte Dokument mit dem maschinell erstellten. Wenn ein Feld fehlt, wirst Du es so am einfachsten finden.

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: m3 am 18.02.11 - 18:46:52

IBM Lotus Notes and Domino Calendaring & Scheduling Schema (http://www-10.lotus.com/ldd/ddwiki.nsf/dx/cs_schema_toc)

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: etofi am 22.02.11 - 11:56:54

Zitat von: Peter Klett am 18.02.11 - 17:27:20

Erstelle Dir ein Dokument, wie Du es haben möchtest, manuell. Vergleiche dann über die Felderliste das manuell erstellte Dokument mit dem maschinell erstellten. Wenn ein Feld fehlt, wirst Du es so am einfachsten finden.

Das habe ich bereits gemacht. Es sind mittlerweile alle Felder drin aber die Fehlermeldung bleibt.
3 Felder haben den "Feld-Flags: SUMMARY" statt "Feld-Flags: SUMMARY NAMES". Ist das tragisch?
Die einzige Variable die ich nicht habe ist die "$MessageID". Ich kann die zwar anlegen, weiß aber nicht woher ich diese ID nehmen soll. Die sieht z.B. so aus "<OF0ADEED9D.4A673CE7-ONC125783E.0049860D-C125783E.00498C03@LocalDomain>"

Zitat von: m3 am 18.02.11 - 18:46:52

IBM Lotus Notes and Domino Calendaring & Scheduling Schema (http://www-10.lotus.com/ldd/ddwiki.nsf/dx/cs_schema_toc)

Leider habe ich hier auch nichts zu meinem Problem gefunden.

Irgendwie komme ich nicht weiter...
Es muß doch eine Lösung dafür geben.

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: etofi am 23.02.11 - 14:24:41

So jetzt läufts. Es lag nicht an fehlenden Variablen sondern daran:

Code

        'Überprüfen vor dem Speichern bzw. Versand
        If .COMPUTEWITHFORM(True, False) Then
            MsgBox "Bei der Erstellung des Termins ist ein Fehler aufgetreten!"
            GoTo proc_exit
        End If

Wenn man das weglässt funktioniert es einwandfrei.
Anbei der neue Code, falls es mal jemand braucht.

Code

Public Function SendNotesTermin(pstrSubject As String, _
                                pstrRecipient As String, _
                                pstrMailBody As String, _
                                AppDate As Date, _
                                StartTime As Date, _
                                MinsDuration As Integer, _
                                pstrLocation As String, _
                                pstrCategories As String, _
                                AppointmentType As String) As String

'Aufgabe:   Sendet Termine via Notes
'Rückgabe:  String mit Fehlermeldung bei auftretendem Fehler, sonst Leerstring
'
'pstrSubject:       Betreff
'pstrRecipient:     Empfänger mit Komma getrennt
'pstrMailBody:      Text
'AppDate:           Datum Termin
'StartTime:         Uhrzeit Termin
'MinsDuration:      Dauer in Minuten
'pstrLocation:      Ort
'pstrCategories:    Kategorie
'AppointmentType:   0=Termin, 1=Jahrestag, 2=Ganztägige Veranstaltung, 3=Meeting, 4=Erinnerung
'
'WICHTIG: Damit die Funktion "Status der eingeladenen Personen prüfen" sauber funktioniert
'         müssen die internen Aderssen im Notes Format "User/Intern/MUSTER" übergeben werden.


On Error GoTo proc_error

Dim objNotesSession         As Object
Dim objNotesDatabase        As Object
Dim objNotesDocument        As Object
Dim strServerName           As String
Dim strMailDbName           As String
Dim strUserName             As String
Dim strUserMail             As String
Dim datStart                As Date
Dim datEnde                 As Date
Dim intIconNr               As Integer
Dim intZaehler              As Integer
Dim dblAnzahlTage           As Double

SendNotesTermin = ""

'Bei ganztägige Veranstaltung auf 4 Uhr Starttag und 22 Uhr Endtage setzen
If AppointmentType = 2 Then
    datStart = CDate(AppDate & " " & "04:00")
    dblAnzahlTage = fktAufrunden(MinsDuration / 60 / 24, 0) ' Berechnung Tage
    datEnde = CDate(Format(DateAdd("d", dblAnzahlTage - 1, datStart), "dd.mm.yyyy") & " 22:00")
Else
    datStart = CDate(AppDate & " " & Format(StartTime, "hh:mm"))
    datEnde = DateAdd("n", MinsDuration, datStart)
End If

Set objNotesSession = CreateObject("Notes.NotesSession")

strUserName = objNotesSession.UserName
strUserMail = Replace(Replace(Replace(strUserName, "CN=", ""), "OU=", ""), "O=", "")
strServerName = objNotesSession.GETENVIRONMENTSTRING("MailServer", True)
strMailDbName = objNotesSession.GETENVIRONMENTSTRING("MailFile", True)

Set objNotesDatabase = objNotesSession.GETDATABASE(strServerName, strMailDbName)
Set objNotesDocument = objNotesDatabase.CREATEDOCUMENT

With objNotesDocument

    '## Appointment Type - Meeting
    .REPLACEITEMVALUE "AppointmentType", AppointmentType
    
    '## General Meeting Info
    .REPLACEITEMVALUE "Form", "Appointment"
    .REPLACEITEMVALUE "Subject", pstrSubject
    .REPLACEITEMVALUE "Categories", pstrCategories
    .REPLACEITEMVALUE "Body", pstrMailBody
    .REPLACEITEMVALUE "Location", pstrLocation
    .REPLACEITEMVALUE "Room", ""
    
    '## Who sent/created/chairs the Meeting
    .REPLACEITEMVALUE "From", objNotesSession.UserName
    .REPLACEITEMVALUE "Chair", objNotesSession.UserName
    
    '## Time of meeting-related stuff
    .REPLACEITEMVALUE "STARTDATETIME", datStart
    .REPLACEITEMVALUE "StartTime", datStart
    .REPLACEITEMVALUE "StartDate", datStart
    .REPLACEITEMVALUE "EndDateTime", datEnde
    .REPLACEITEMVALUE "EndTime", datEnde
    .REPLACEITEMVALUE "EndDate", datEnde
    
    If AppointmentType = 2 Then 'Bei ganztägige Veranstaltung Je Tag Ein Arrayeintag erforderlich
        
        Dim arrCalenderDateTime() As Date
        ReDim arrCalenderDateTime(dblAnzahlTage - 1)
        For intZaehler = 0 To dblAnzahlTage - 1
             arrCalenderDateTime(intZaehler) = DateAdd("d", intZaehler, datStart)
        Next
        .REPLACEITEMVALUE "CalendarDateTime", arrCalenderDateTime
    
    Else
        
        .REPLACEITEMVALUE "CalendarDateTime", datStart
    
    End If
    
    
    '## Attendee-related data
    If AppointmentType = 3 Then 'Meeting
        Dim arrRequiredAttendeeName() As String
        arrRequiredAttendeeName = Split(pstrRecipient, ",")
        For intZaehler = 0 To UBound(arrRequiredAttendeeName)
            'Bei den Empfängern darf der Absender nicht enthalten sein!!
            If Trim(arrRequiredAttendeeName(intZaehler)) = strUserMail Then
                arrRequiredAttendeeName(intZaehler) = vbNullString
            Else
                arrRequiredAttendeeName(intZaehler) = Trim(arrRequiredAttendeeName(intZaehler))
            End If
        Next
        
        .APPENDITEMVALUE "RequiredAttendees", arrRequiredAttendeeName
        .APPENDITEMVALUE "AltRequiredNames", arrRequiredAttendeeName
    
        'Call objNotesDocument.AppendItemValue("INetRequiredNames", arrRequiredAttendeeNameAndEmail)
        'Call objNotesDocument.REPLACEITEMVALUE("StorageRequiredNames", ".")
        
        .APPENDITEMVALUE "SendTo", arrRequiredAttendeeName
        'Call objNotesDocument.APPENDITEMVALUE("NoticeType", "I")
    End If
    
    '## System variables
    .REPLACEITEMVALUE "$UpdatedBy", objNotesSession.UserName
    .REPLACEITEMVALUE "OrgTable", "C0"
    .REPLACEITEMVALUE "Principal", objNotesSession.UserName
    .REPLACEITEMVALUE "$Alarm", 1
    .REPLACEITEMVALUE "$AlarmOffset", -15
    .REPLACEITEMVALUE "Alarms", "1"
    
    Select Case AppointmentType
        Case 0 'Appointment
            intIconNr = 160
        Case 1 'Anniversary
            intIconNr = 63
        Case 2 'AllDayEvent
            intIconNr = 9
        Case 3 'Meeting
            intIconNr = 158
        Case 4 'Reminder
            intIconNr = 10
    End Select
    .REPLACEITEMVALUE "_ViewIcon", intIconNr
    
    If AppointmentType = 3 Then .SEND False 'Wenn Meeting dann Einladungen senden
    .Save True, False
    
    'Damit der Alarm auch funtioniert
    .PUTINFOLDER "$Alarms", True

End With


proc_exit:
    Set objNotesDocument = Nothing
    Set objNotesDatabase = Nothing
    Set objNotesSession = Nothing
    Exit Function
    
proc_error:
    SendNotesTermin = Err.Description
    Resume proc_exit
    
End Function

Public Function fktAufrunden(Zahl As Double, Stellen As Integer) As Double

If IsNull(Zahl) = True Then
  fktAufrunden = 0
Else
  Zahl = CDec(Zahl)
  If ((Zahl - Int(Zahl)) * 10 ^ Stellen) = 0 Then
     fktAufrunden = Int(Zahl) + (Int(((Zahl - Int(Zahl)) * 10 ^ Stellen)) / 10 ^ Stellen)
  Else
     fktAufrunden = Int(Zahl) + (Int(((Zahl - Int(Zahl)) * 10 ^ Stellen) + 1) / 10 ^ Stellen)
  End If
End If

End Function

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: etofi am 26.03.12 - 14:42:17

Wir haben jetzt Notes 8.5.2 das hat leichte Anpassungen erforderlich gemacht.
Anbei der neue Code

Code

Public Function SendNotesTermin(pstrSubject As String, _
                                pstrRecipient As String, _
                                pstrMailBody As String, _
                                AppDate As Date, _
                                StartTime As Date, _
                                MinsDuration As Integer, _
                                pstrLocation As String, _
                                pstrCategories As String, _
                                AppointmentType As String) As String

'Aufgabe:   Sendet Termine via Notes
'Rückgabe:  String mit Fehlermeldung bei auftretendem Fehler, sonst Leerstring
'
'pstrSubject:       Betreff
'pstrRecipient:     Empfänger mit Komma getrennt
'pstrMailBody:      Text
'AppDate:           Datum Termin
'StartTime:         Uhrzeit Termin
'MinsDuration:      Dauer in Minuten
'pstrLocation:      Ort
'pstrCategories:    Kategorie
'AppointmentType:   0=Termin, 1=Jahrestag, 2=Ganztägige Veranstaltung, 3=Meeting, 4=Erinnerung
'
'WICHTIG: Damit die Funktion "Status der eingeladenen Personen prüfen" sauber funktioniert
'         müssen die internen Aderssen im Notes Format "Max Muster/Intern/xxxx" übergeben werden.


On Error GoTo proc_error

Dim objNotesSession             As Object
Dim objNotesDatabase            As Object
Dim objNotesDocument            As Object
Dim objItem                     As Object
Dim strServerName               As String
Dim strServerEinzelname()       As String
Dim strMailDbName               As String
Dim strUserName                 As String
Dim strUserEinzelname()         As String
Dim strUserMail                 As String
Dim datStart                    As Date
Dim datEnde                     As Date
Dim intZaehler                  As Integer
Dim dblAnzahlTage               As Double
Dim strCSTrack(2)               As String
Dim intAnzahlEmpfaenger         As Integer
Dim strStorageRequiredNames()   As String


SendNotesTermin = ""

'Bei ganztägige Veranstaltung auf 4 Uhr Starttag und 22 Uhr Endtage setzen
If AppointmentType = 2 Then
    datStart = CDate(AppDate & " " & "04:00")
    dblAnzahlTage = fktAufrunden(MinsDuration / 60 / 24, 0) ' Berechnung Tage
    datEnde = CDate(Format(DateAdd("d", dblAnzahlTage - 1, datStart), "dd.mm.yyyy") & " 22:00")
Else
    datStart = CDate(AppDate & " " & Format(StartTime, "hh:mm"))
    datEnde = DateAdd("n", MinsDuration, datStart)
End If

Set objNotesSession = CreateObject("Notes.NotesSession")

strUserName = objNotesSession.UserName
strUserMail = Replace(Replace(Replace(strUserName, "CN=", ""), "OU=", ""), "O=", "")
strServerName = objNotesSession.GETENVIRONMENTSTRING("MailServer", True)
strMailDbName = objNotesSession.GETENVIRONMENTSTRING("MailFile", True)

strServerEinzelname = Split(Replace(Replace(Replace(strServerName, "CN=", ""), "OU=", ""), "O=", ""), "/")
strUserEinzelname = Split(Replace(Replace(Replace(strUserName, "CN=", ""), "OU=", ""), "O=", ""), "/")

Set objNotesDatabase = objNotesSession.GETDATABASE(strServerName, strMailDbName)
Set objNotesDocument = objNotesDatabase.CREATEDOCUMENT

With objNotesDocument

    'Universal ID eintragen
    .APPTUNID = objNotesDocument.UNIVERSALID

    'Appointment Type
    .REPLACEITEMVALUE "Form", "Appointment"
    .REPLACEITEMVALUE "AppointmentType", AppointmentType
    
    
    'Was, wo und warum
    .REPLACEITEMVALUE "Categories", pstrCategories
    .REPLACEITEMVALUE "Location", pstrLocation
    .REPLACEITEMVALUE "Subject", pstrSubject
    .REPLACEITEMVALUE "Body", pstrMailBody

    'Eigentümer
    .REPLACEITEMVALUE "Chair", objNotesSession.UserName
    .REPLACEITEMVALUE "AltChair", objNotesSession.UserName
    .REPLACEITEMVALUE "From", objNotesSession.UserName
    Set objItem = .GETFIRSTITEM("From")
    objItem.ISNAMES = True
    objItem.ISAUTHORS = True
    Set objItem = Nothing
    .REPLACEITEMVALUE "Principal", objNotesSession.UserName
    .REPLACEITEMVALUE "$AltPrincipal", objNotesSession.UserName
    
    'Einstellung einer Erinnerung in Minuten
    .REPLACEITEMVALUE "$Alarm", 1
    .REPLACEITEMVALUE "$AlarmOffset", -15
    .REPLACEITEMVALUE "Alarms", "1"
    
    'Welches Icon soll angezeigt werden
    Select Case AppointmentType
        Case 0 'Appointment
            .REPLACEITEMVALUE "_ViewIcon", 160
            .REPLACEITEMVALUE "$IconSwitcher", "Appointment"
        Case 1 'Anniversary
            .REPLACEITEMVALUE "_ViewIcon", 63
            .REPLACEITEMVALUE "$IconSwitcher", "Anniversary"
        Case 2 'AllDayEvent
            .REPLACEITEMVALUE "_ViewIcon", 9
            .REPLACEITEMVALUE "$IconSwitcher", "AllDayEvent"
        Case 3 'Meeting
            .REPLACEITEMVALUE "_ViewIcon", 158
            .REPLACEITEMVALUE "$IconSwitcher", "Meeting"
        Case 4 'Reminder
            .REPLACEITEMVALUE "_ViewIcon", 10
            .REPLACEITEMVALUE "$IconSwitcher", "Reminder"
    End Select

    'Zeit und Datum
    .REPLACEITEMVALUE "StartDateTime", datStart
    .REPLACEITEMVALUE "EndDateTime", datEnde
    .REPLACEITEMVALUE "StartDate", datStart
    .REPLACEITEMVALUE "StartTime", datStart
    .REPLACEITEMVALUE "EndDate", datEnde
    .REPLACEITEMVALUE "EndTime", datEnde
    .REPLACEITEMVALUE "$NoPurge", datEnde
    
    If AppointmentType = 2 Then 'Bei ganztägige Veranstaltung je Tag Ein Arrayeintag erforderlich

        Dim arrCalenderDateTime() As Date
        ReDim arrCalenderDateTime(dblAnzahlTage - 1)
        For intZaehler = 0 To dblAnzahlTage - 1
             arrCalenderDateTime(intZaehler) = DateAdd("d", intZaehler, datStart)
        Next
        .REPLACEITEMVALUE "CalendarDateTime", arrCalenderDateTime

    Else

        .REPLACEITEMVALUE "CalendarDateTime", datStart

    End If


    '## Attendee-related data
    If AppointmentType = 3 Then 'Meeting
        
        Dim arrRequiredAttendeeName() As String
        arrRequiredAttendeeName = Split(pstrRecipient, ",")
        
        For intZaehler = 0 To UBound(arrRequiredAttendeeName)
            'Bei den Empfängern darf der Absender nicht enthalten sein!!
            If Trim(arrRequiredAttendeeName(intZaehler)) = strUserMail Then
                arrRequiredAttendeeName(intZaehler) = vbNullString
            Else
                arrRequiredAttendeeName(intZaehler) = Trim(arrRequiredAttendeeName(intZaehler))
            End If
        Next

        .REPLACEITEMVALUE "Recipients", arrRequiredAttendeeName
        .REPLACEITEMVALUE "RequiredAttendees", arrRequiredAttendeeName
        '.REPLACEITEMVALUE "AltRequiredNames", arrRequiredAttendeeName
        .REPLACEITEMVALUE "SendTo", arrRequiredAttendeeName
        Set objItem = .GETFIRSTITEM("SendTo")
        objItem.ISNAMES = True
        objItem.ISSIGNED = True
        Set objItem = Nothing
        '.REPLACEITEMVALUE "INetRequiredNames", arrRequiredAttendeeNameAndEmail
        
        intAnzahlEmpfaenger = UBound(arrRequiredAttendeeName)
        ReDim strStorageRequiredNames(intAnzahlEmpfaenger)
        
        For intZaehler = 0 To intAnzahlEmpfaenger
            strStorageRequiredNames(intZaehler) = "1"
        Next
        .REPLACEITEMVALUE "StorageRequiredNames", strStorageRequiredNames
        Set objItem = .GETFIRSTITEM("StorageRequiredNames")
        objItem.ISNAMES = True
        Set objItem = Nothing
        
        .REPLACEITEMVALUE "$CSVersion", "2"
        .REPLACEITEMVALUE "$CSWISL", Array("$S:1", "$L:1", "$B:1", "$R:1", "$E:1", "$W:1", "$O:1", "$M:1")
        .REPLACEITEMVALUE "$WatchedItems", Array("$S", "$L", "$B", "$R", "$E", "$W", "$O", "$M")

        strCSTrack(0) = "Send[" & strServerEinzelname(0) & "] by Notes on " & strUserEinzelname(0) & "(" & objNotesSession.NOTESVERSION & ") at " & Format(Now(), "DD.MM.YYYY HH:MM:SS")
        strCSTrack(1) = "PrepareToSend[" & strServerEinzelname(0) & "] by Notes on " & strUserEinzelname(0) & "(" & objNotesSession.NOTESVERSION & ") at " & Format(Now(), "DD.MM.YYYY HH:MM:SS")
        strCSTrack(2) = "Restore[" & strServerEinzelname(0) & "] by Notes on " & strUserEinzelname(0) & "(" & objNotesSession.NOTESVERSION & ") at " & Format(Now(), "DD.MM.YYYY HH:MM:SS")
        .REPLACEITEMVALUE "$CSTrack", strCSTrack
        
        .REPLACEITEMVALUE "$TableSwitcher", "Description"
        .REPLACEITEMVALUE "NoticeType", "I"

    End If

    '## BusyTime Items
    .REPLACEITEMVALUE "$BusyName", strUserName
    Set objItem = .GETFIRSTITEM("$BusyName")
    objItem.ISNAMES = True
    Set objItem = Nothing
    .REPLACEITEMVALUE "BookFreeTime", ""
    .REPLACEITEMVALUE "$BusyPriority", "1"

    '## System variables
    .REPLACEITEMVALUE "$UpdatedBy", objNotesSession.UserName
    .REPLACEITEMVALUE "OrgTable", "C0"
    .REPLACEITEMVALUE "$PublicAccess", "1"
    .REPLACEITEMVALUE "StartTimeZone", "Z=-1$DO=1$DL=3 -1 1 10 -1 1$ZX=86$ZN=W. Europe"
    .REPLACEITEMVALUE "$ExpandGroups", "3"
    
    .REPLACEITEMVALUE "$FromPreferredLanguage", "de"
    .REPLACEITEMVALUE "$LangChair", ""
    .REPLACEITEMVALUE "$SMTPKeepNotesItem", "1"
    
    .REPLACEITEMVALUE "UpdateSeq", 1
    .REPLACEITEMVALUE "WebDateTimeInit", "1"
    
    .REPLACEITEMVALUE "ExcludeFromView", Array("S", "D")
    .REPLACEITEMVALUE "MailOptions", ""
    
    .REPLACEITEMVALUE "Resources", ""
    .REPLACEITEMVALUE "Repeats", ""
    .REPLACEITEMVALUE "RoomToReserve", ""
        

    'Überprüfen vor dem Speichern bzw. Versand
    If .COMPUTEWITHFORM(True, False) = False Then
        MsgBox "Bei der Erstellung des Termins ist ein Fehler aufgetreten!"
        GoTo proc_exit
    End If

    'Wenn Meeting dann Einladungen senden
    If AppointmentType = 3 Then
        .SAVEMESSAGEONSEND = False ' bei True wird ein Exemplar in Notes in Gesendet gestellt
        .SIGNONSEND = True
        
        'Bereinigungen damit Einladung optisch richtig ankommt
        .REPLACEITEMVALUE "Form", "Notice"
        .REPLACEITEMVALUE "_ViewIcon", 133 'Invitation
        .REPLACEITEMVALUE "ExcludeFromView", Array("A")
        Set objItem = .GETFIRSTITEM("$BusyPriority")
        objItem.Remove
        Set objItem = Nothing
        Set objItem = .GETFIRSTITEM("CalendarDateTime")
        objItem.Remove
        Set objItem = Nothing
        
        'senden
        .SEND False
        
        'Bereinigungen wieder zurück
        .REPLACEITEMVALUE "Form", "Appointment" 'Meeting
        .REPLACEITEMVALUE "_ViewIcon", 158
        .REPLACEITEMVALUE "ExcludeFromView", Array("S", "D")
        .REPLACEITEMVALUE "$BusyPriority", "1"
        .REPLACEITEMVALUE "CalendarDateTime", datStart

        
        'Bereinigungend damit Meeting richtig gespeichert wird und es keine Fehlermeldungen bei Änderung gibt
        Set objItem = .GETFIRSTITEM("SendTo")
        objItem.Remove
        Set objItem = Nothing
        Set objItem = .GETFIRSTITEM("NoticeType")
        objItem.Remove
        Set objItem = Nothing
        
    End If

    'Im Kalender speichern
    .Save True, False

    'Damit der Alarm auch funtioniert
    .PUTINFOLDER "$Alarms", True

End With


proc_exit:
    Set objNotesDocument = Nothing
    Set objNotesDatabase = Nothing
    Set objNotesSession = Nothing
    Exit Function

proc_error:
    SendNotesTermin = Err.Description
    Resume proc_exit

End Function

Public Function fktAufrunden(Zahl As Double, Stellen As Integer) As Double

If IsNull(Zahl) = True Then
  fktAufrunden = 0
Else
  Zahl = CDec(Zahl)
  If ((Zahl - Int(Zahl)) * 10 ^ Stellen) = 0 Then
     fktAufrunden = Int(Zahl) + (Int(((Zahl - Int(Zahl)) * 10 ^ Stellen)) / 10 ^ Stellen)
  Else
     fktAufrunden = Int(Zahl) + (Int(((Zahl - Int(Zahl)) * 10 ^ Stellen) + 1) / 10 ^ Stellen)
  End If
End If

End Function

Grüße
Eric Trösch

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: Jenny85 am 29.08.12 - 08:35:20

Hallo zusammen,

ich habe diesen Code gesehen, und denke er könnte ziemlich genau das sein was ich suche. Kann mir jemand sagen wie der Sub zu dieser Funktion ausehen müsste??

Vielen Dank vorab!

Grüße aus dem sonnigen Allgäu

Jenny

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: etofi am 29.08.12 - 09:20:13

Zitat von: Jenny85 am 29.08.12 - 08:35:20

Kann mir jemand sagen wie der Sub zu dieser Funktion ausehen müsste??

Hmm - die Frage verstehe ich jetzt nicht wirklich.
Man macht in vba ein Codemudule, packc die Funktion rein und ruft dann von beliebiger Stelle die Funktion mit

Call SendNotesTermin("Betreff","Empfängermail","Termintext",01.01.2013,[Dauer in Minuten],"Ort","Kategorie",[Terminart])

auf.

Grüße
etofi

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: Jenny85 am 29.08.12 - 09:39:45

So wollt ichs auch probieren, da kommt dann immer die Fehlermeldung "Argument ist nicht optional" mit Markierung auf "Call SendNotesTermin" ....

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: etofi am 29.08.12 - 09:44:20

Zitat von: Jenny85 am 29.08.12 - 09:39:45

So wollt ichs auch probieren, da kommt dann immer die Fehlermeldung "Argument ist nicht optional" mit Markierung auf "Call SendNotesTermin" ....

Poste mal den Code, dann wird es evtl einfacher...
Oder schicke mir die Datei per PN dann schau ich mir das mal an.

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: Jenny85 am 29.08.12 - 10:38:25

Hallo,

also hier mein Code:

Public cbList As Variant

Private Sub CommandButton2_Click()
On Error Resume Next
Sheets(ComboBox1.Value).Activate
Call Kalendereintrag
Unload Me
End Sub

Private Sub userform_Initialize()

With ShEinstellungen
cbList = .Range(.Cells(10, 5), .Cells(Rows.Count, 5).End(xlUp)).Value
End With

With Me.ComboBox1
.MatchEntry = fmMatchEntryNone
.List = cbList
End With

End Sub

Private Sub ComboBox1_Change()
Dim dic As Object
Dim a As Variant

Set dic = CreateObject("Scripting.Dictionary")

For Each a In cbList
If LCase(Left(a, Len(Me.ComboBox1.Value))) = LCase(Me.ComboBox1.Value) Then dic(a) = 1
Next a

Me.ComboBox1.List = dic.keys
Me.ComboBox1.DropDown

Set dic = Nothing
End Sub
Private Sub combobox1_Click()
On Error Resume Next
Sheets("Einstellungen").[G7] = ComboBox1.Value
Sheets("Einstellungen").[G8] = Sheets(ComboBox1.Value).Range("B3").Value
Sheets(ComboBox1.Value).Activate
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub

So und dann hatte ich es erst so:

Sub Kalendereintag()

Call SendNotesTermin(Sheets(ComboBox1.Value), "shecky_darling@web.de", Sheets(ComboBox1.Value).Range("B3").Value, Sheets(ComboBox1.Value).Range("B7").Value, [60], Sheets(ComboBox1.Value).Range("B8").Value, "Meeting", [3])
End Sub

und habs dann mit einer "Vereinfachen Variante" ... zumindest dachte ich das ... probiert:

Private Sub CommandButton1_Click()
Call SendNotesTermin("Test", "shecky_darling@web.de", "Termintext", "04.09.2012", [60], "Kempten", "Meeting", [3])
End Sub

Vielen Dank schon mal für deine Hilfe!
VG Jenny

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: etofi am 29.08.12 - 11:08:57

Zitat von: Jenny85 am 29.08.12 - 10:38:25

Call SendNotesTermin("Test", "shecky_darling@web.de", "Termintext", "04.09.2012", [60], "Kempten", "Meeting", [3])

Du musst schon die Werte MinsDuration und AppointmentType im definierten Format übergeben.
Sprich als Integer und String, die Eckigen Klammern waren nur als Platzhalter für eine Variable gedacht...

Call SendNotesTermin("Test", "shecky_darling@web.de", "Termintext", "04.09.2012", 60, "Kempten", "Meeting", "3")

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: Jenny85 am 30.08.12 - 14:44:41

Hallo,

naja nach langem hin und her habe ich eingesehen, dass ich es einfach nicht hinbekommen werde mit einer Funktion zu arbeiten ... :'(

also hab ich mir das ganze jetzt einfach in ein Sub umgebastelt. Falls jemand das gleiche Problem haben sollte wie ich:

Sub Vorlagefüllen()

Sheets("Schulungsunterlagen").Activate
For i = 10 To 55
y = Sheets("Schulungsunterlagen").Cells(i, 2).Value
For x = 17 To 31 Step 3
If Cells(i, x) <> "" Then
Sheets("Einstellungen").Range("J22").Value = Sheets("Schulungsunterlagen").Cells(i, x + 1).Value
Sheets("Einstellungen").Range("J19").Value = Sheets(y).Range("B3").Value
Sheets("Einstellungen").Range("J20").Value = Sheets(y).Range("K11").Value & "," & Sheets(y).Range("K12").Value & "," & Sheets(y).Range("K13").Value & "," & Sheets(y).Range("K14").Value
Sheets("Einstellungen").Range("J23").Value = Sheets("Schulungsunterlagen").Cells(i, x).Value
Sheets("Einstellungen").Range("J24").Value = (CDate(Sheets("Schulungsunterlagen").Cells(i, x + 2).Value) - CDate(Sheets("Schulungsunterlagen").Cells(i, x + 1).Value)) * 60 * 24
Sheets("Einstellungen").Range("J25").Value = Sheets(y).Range("B9").Value
Sheets("Einstellungen").Range("J26").Value = "Seminar"
Sheets("Einstellungen").Range("J27").Value = "3"
Call SendNotesTermin
Else
Exit For
End If
Next x
Next i
Sheets("Start").Activate
End Sub

Sub SendNotesTermin()

On Error GoTo proc_error

Dim objNotesSession As Object
Dim objNotesDatabase As Object
Dim objNotesDocument As Object
Dim objItem As Object
Dim strServerName As String
Dim strServerEinzelname() As String
Dim strMailDbName As String
Dim strUserName As String
Dim strUserEinzelname() As String
Dim strUserMail As String
Dim datStart As Date
Dim datEnde As Date
Dim intZaehler As Integer
Dim dblAnzahlTage As Double
Dim strCSTrack(2) As String
Dim intAnzahlEmpfaenger As Integer
Dim strStorageRequiredNames() As String
Dim pstrSubject As String
Dim pstrRecipient As String
Dim pstrMailBody As String
Dim AppDate As Date
Dim StartTime As Date
Dim MinsDuration As Integer
Dim pstrLocation As String
Dim pstrCategories As String
Dim AppointmentType As String

'Vabriablen bestimmung in Einstellungen J19-J27 über Sub Vorlagefüllen()
a = Sheets("Einstellungen").Range("J19").Value
b = Sheets("Einstellungen").Range("J20").Value
c = Sheets("Einstellungen").Range("J21").Value
d = Sheets("Einstellungen").Range("J22").Value
e = Sheets("Einstellungen").Range("J23").Value
f = Sheets("Einstellungen").Range("J24").Value
g = Sheets("Einstellungen").Range("J25").Value
h = Sheets("Einstellungen").Range("J26").Value
i = Sheets("Einstellungen").Range("J27").Value

pstrSubject = a
pstrRecipient = b
pstrMailBody = c
AppDate = e
StartTime = d
MinsDuration = f
pstrLocation = g
pstrCategories = h
AppointmentType = i

'Bei ganztägige Veranstaltung auf 4 Uhr Starttag und 22 Uhr Endtage setzen

--> ab hier geht es dann wieder ganz normal wie oben weiter.

Vielen Dank für die Unterstützung und den tollen Code!

VG Jenny

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: mor_lana am 01.09.12 - 17:31:01

Zitat von: etofi am 26.03.12 - 14:42:17

Wir haben jetzt Notes 8.5.2 das hat leichte Anpassungen erforderlich gemacht.
Anbei der neue Code

Grüße
Eric Trösch

Herzlichen Dank für den Code.

Grüße
Martin

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: Jenny85 am 20.09.12 - 10:39:58

Hallo zusammen,

in der Umsetztung ist jetzt doch noch ein unerwarteter Fehler aufgetreten, ich hoffe jemand kann mir sagen woran das liegt....

Wenn ich den Termin erstelle, wird er bei mir richtig angezeigt. Die eingeladenen Personen bekommen die Einladung allerdings ohne Betreff ... obwohl dieser in meinem Kalender angezeigt wird.

Weis jemand wo das Problem liegt??

Vielen Dank vorab!

Grüße Jenny

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: ascabg am 20.09.12 - 11:38:19

Hallo,

Weil, wenn ich es richtig gesehen habe, beim Senden der Form 'Notice' kein Subject angegeben ist.

Andreas

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: Jenny85 am 20.09.12 - 13:40:56

Hallo Andreas,

wenn ich aber Appointment statt Notice angebe, kommt zwar die Überschrift, die Mail kommt dann aber nicht mehr als "Kalendereinladung" sondern als ganz normal Mail und dazu noch ziemlich verzerrt ...

Kann ich das Object bei Notice nachpflegen?

Vielen Dank.

Grüße Jenny

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: ascabg am 20.09.12 - 13:52:15

Vorsicht,

Du versendest kein Appointment (Maske), sondern eine Mail mit der Form (Maske) Notice.
Daran erkennt der Empfaenger, dass es sich um eine Einladung handelt und bietet die entsprechenden Buttons (Annehmen, Ablehnen, ...) an.
Klickt der Empfaenger auf einen der Buttons, z.B. Annehmen, wandelt der dadurch ausgeloeste Code die Daten aus der Einladung (Notice) in ein Appointment um.

Und der Maske Notice kannst Du natuerlich auch ein Feld mit dem Namen Subject mitgeben.

Andreas

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: koehlerbv am 20.09.12 - 13:58:38

Andreas, das ist aber in dem Fall keine Maske, sondern ein Dokument. Nicht, dass Jenny hier durcheinanderkommt.

@Jenny: Wie Items erzeugt und belegt werden, wird oft genug im Code verwendet, das findest Du also auch selbst heraus.

Bernhard

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: ascabg am 20.09.12 - 14:02:37

Ja, ich weiss Bernhard.

Andreas

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: Jenny85 am 20.09.12 - 16:27:13

... sagst du so .... ich kann eigentlich eher kleine Schleifen und der gleichen ....

dachte ich müsste:
.REPLACEITEMVALUE "Subject", pstrSubject unter Bereinigung setzen, Ergebnis bleibt aber gleich... :-:

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: Hustenstorch am 18.06.13 - 09:52:58

Zitat von: etofi am 26.03.12 - 14:42:17

Wir haben jetzt Notes 8.5.2 das hat leichte Anpassungen erforderlich gemacht.
Anbei der neue Code
...
Grüße
Eric Trösch

Hallo,

genau danach habe ich gesucht!
Ich musste den Code für meine Anforderung nur geringfügig ändern. Ansonsten wie maßgeschneidert.

Allerdings hätte ich gern noch, daß wenn in den Kalender ein Meeting eingetragen wird, da an die Einladung auch noch ein Anhang mit dran kommt (ein docx von einem festen Laufwerk).

Kann mir da jemand weiterhelfen?

Vielen Dank!
Hustenstorch

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: koehlerbv am 18.06.13 - 19:01:56

NotesRichTextItem.EmbedObject

Wenn einem das gar nichts sagt: Finger weg und lernen.
Wenn es konkrete Fragen gibt, dann gibt es hier Hilfe.

Titel: Re: Per VBA Meeting in Notes Kalender eintragen und Einladungen senden
Beitrag von: Hustenstorch am 18.06.13 - 21:40:54

Besten Dank erstmal.

Sagen tut mir das was.
Damit kann ich was anfangen.

Das Notes Forum

Domino 9 und frühere Versionen => ND7: Entwicklung => Thema gestartet von: etofi am 18.02.11 - 14:54:27