Hallo zusammen,
ich habe ein Problem mit dem exportieren von Kalenderfiles aus Lotus Notes 8.5. Ich verschicke Termine aus meinem Lotus Kalender über Exportieren als ics. Der Empfänger kann den Termin dann übernehmen oder auch nicht je nachdem ob er für ihn relevant ist.
Das hat bislang auch immer super funktioniert. Dieses Jahr hatte ich aber beschlossen keine 70 Kalendereinträge händisch zu erstellen und hab nach vielem hin und her ein Makro & einen geduldigen Kollegen gefunden um diese über Excel VBA automatisch zu versenden. Das funktioniert mittlerweile auch einwandfrei.
Jetzt, 2 Monate später muss ich den ersten Eintrag weiterversenden. Das Exportieren klappt soweit auch noch. Den ics File speichere ich auf meinem Laufwerk und versende ihn anschließend als Mail Anhang.
Möchte der Empfänger den Anhang öffnen kommt eine Fehlermeldung mit dem Text: "Die Datei kann zurzeit nicht importiert werden. Sie wird nicht unterstützt."
Kann mir jemand helfen und mir sagen woran das liegt?
Oder mir sagen wie ich aus Daten aus einer Excel Datei ics Files kreieren lassen kann?
Das verwendete Makro anbei.
Vielen Dank vorab!
Grüße Jenny
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
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 14:00 Uhr Starttag und 16:00 Uhr Endtage setzen
If appointmenttype = 2 Then
datStart = CDate(appdate & " " & "14:00")
dblAnzahlTage = fktAufrunden(minsduration / 60 / 24, 0) ' Berechnung Tage
datEnde = CDate(Format(DateAdd("d", dblAnzahlTage - 1, datStart), "dd.mm.yyyy") & " 16: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
Thema: Exportieren von über VBA erstellten Kalenderfiles aus Lotus Notes 8.5 (Gelesen 2826 mal)