Bei Outlook "Freigegebene Kalender" ansprechen und nicht die StandardMAPI
- Outlook
Sie verwenden einen veralteten Browser (%browser%) mit Sicherheitsschwachstellen und können nicht alle Funktionen dieser Webseite nutzen.
Hier erfahren Sie, wie einfach Sie Ihren Browser aktualisieren können.
Hier erfahren Sie, wie einfach Sie Ihren Browser aktualisieren können.
Es gibt 52 Antworten in diesem Thema. Der letzte Beitrag () ist von Kleiner_VBAler.
-
-
petaod schrieb:
Ich habe den Codeausschnitt auf meiner Maschine getestet und da funktioniert er.
Wie? Moment mal, d.h., dass das Script bei DIR das tut, was es tun soll? Bzw. es eigtl. müsste, da ich mal davon ausgehe, dass du keinen Exchange zur Hand hast?...
Ja super, dann kann ich ja lange weiter suchen, wenn es bei dir geht und bei mir nicht....... -
Ich habe nicht das komplette Script getestet, da mir das zunächst mal zu unübersichtlich ist.
Aber ich habe es bis zu dem PunktSet MyFolder = Cal.Items
problemlos am Laufen.
Was bei mir dann schief geht ist das Erzeugen einer CDO-Session.
Set objCDO = CreateObject("MAPI.Session")
Aber das ist ja anscheinend ein möglicherweise erwartetes Verhalten.
Darüber hinaus habe ich mich bisher nicht weiter für das Script interessiert.
Dafür ist es für mich zu chaotisch geschrieben.--
If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
-- -
Ich habe jetzt nicht alles analysiert. Ich meine mich zu erinnern, dass es Unterschiede gibt, wenn ein User nur einen freigegebenen oder mehrere freigegebene Kalender hat. Soweit ich mich erinnere, bin ich damals alle Kalender bzw. Freigaben durchgegangen, ob es da noch weitere Kalender Folder im Kalender gibt.Gruß
Peterfido
Keine Unterstützung per PN! -
Danke euch beiden! @petaod, bis zu den Punkt (Set MyFolder = MyCalendar.Items) geht es bei mir auch noch
Ne, jetzt mal ohne Spaß, kannst du mir mal dein komplettes Script posten, bitte? Also das was bei dir lief. Vllt. hat sich bei mir ja ein Fehler eingeschlichen, der über das Probieren kam und sich unbemerkt in meinem Code hält bzw. hast du noch etwas verändert, was dir gar nicht mehr auffällt, es aber die ein Lösungsansatz ist. Danke dir. -
Visual Basic-Quellcode
- Sub Test()
- DisplayYearlyCalendar SharedCalender("user@mydomain.com")
- End Sub
- Function SharedCalender(ByVal MailAddress As String) As Object
- Dim NS As Outlook.NameSpace
- Dim Owner As Outlook.Recipient
- On Error GoTo Done
- Set MAPI = Application.GetNamespace("MAPI")
- Set Owner = MAPI.CreateRecipient(MailAddress)
- Owner.Resolve
- If Owner.Resolved Then Set SharedCalender = MAPI.GetSharedDefaultFolder(Owner, olFolderCalendar)
- Done:
- End Function
- Sub DisplayYearlyCalendar(ByVal Cal As Object)
- Const ForWriting = 2
- Dim Mbx As String, Shell As Object, FS As Object, Folder As String
- Set Shell = CreateObject("WScript.Shell")
- Set FS = CreateObject("Scripting.FileSystemObject")
- Folder = Shell.ExpandEnvironmentStrings("%TEMP%") & "\YearCalendar"
- If Not FS.FolderExists(Folder) Then FS.CreateFolder Folder
- 'Set OL = CreateObject("Outlook.Application") 'external
- Set OL = Application 'outlook internal
- Set MAPI = OL.GetNamespace("MAPI")
- Mbx = Replace(Replace(Cal.Parent.Name, "Mailbox - ", ""), "Postfach - ", "")
- Server = GetExchangeServer(Mbx)
- 'FILTER CATEGORIES
- 'list here the categories that you want to hide
- arrExcludeCategories = Array()
- 'arrExcludeCategories = Array("Personal", "StaffMeetings")
- 'HIDE PRIVATE APPOINTMENTS
- 'Set this to TRUE if you want to display private appointments
- Const blShowPrivateAppointments = True
- 'ALIGN BY WEEKDAY / DAY-OF-MONTH
- 'Set this to FALSE if you want the rows to be the day of month (1,2, ...31) iso. the days of the week (Mo .. Fri)
- Const blAlignWeekDays = True
- 'ONLY ALL-DAY-EVENTS
- 'Set this to TRUE if you want to display AllDayEvents only
- blAllDayEventsOnly = False
- 'COLORS used
- 'colors from http://web.njit.edu/~kevin/rgb.txt.html
- Const wheat_light = "#EED8AE"
- Const wheat_dark = "#CDBA96"
- Const seashell = "#EEE5DE"
- Const silver = "#C0C0C0"
- Const cornsilk = "#FFF8DC"
- 'NAME AND LOCATION OF HTML OUTPUT FILES
- strHtmlFile = strTempFolder & "\YearlyCalendar.html"
- strHtmlFileTransposed = strTempFolder & "\YearlyCalendarTransposed.html"
- strHtmlFile7Columns = strTempFolder & "\YearlyCalendar7Columns.html"
- 'SCRIPT BEGIN
- 'ASKING FOR TIMESPAN TO BE DISPLAYED
- 'ENTER 13 for next January etc.
- StartMonth = InputBox("Start Month", "Start Month", Month(Date))
- If StartMonth = "" Then Exit Sub
- StartMonth = CInt(StartMonth)
- EndMonth = InputBox("End Month", "End Month", StartMonth - 1)
- If EndMonth = "" Then Exit Sub
- EndMonth = CInt(EndMonth)
- If EndMonth < StartMonth Then
- NbMonths = EndMonth - StartMonth + 13
- EndMonth = EndMonth + 12
- Else
- NbMonths = EndMonth - StartMonth + 1
- End If
- 'DISPLAY EMPTY CALENDAR?
- strEmptyCalendar = vbNo
- 'strEmptyCalendar = MsgBox("Empty Calendar?", vbYesNo + vbDefaultButton2)
- Dim arrTable(100, 100) 'array used to created the transposed version of the calendar
- 'Create Table: 1 Header Row
- ' 7 days x 5 weeks = 35 day rows
- ' 1 Header column
- ' 1 column for each month
- strHeader = "<head><title>Yearly Calendar</title></head>"
- 'NOTE: We are trying to use the available space efficiently to put all appointments on one sheet of paper
- 'You should play around with the "font-size:50%" bit, depending on how packed your calendar is
- strTableHeader = Contents & vbCrLf & "<table width=100% border=1 style='font-family:verdana;font-size:50%;border-width:1px;border-collapse:collapse;cellpadding:2;border-color:gray'>"
- 'header row
- Contents = Contents & vbCrLf & "<TR valign='top' bgcolor='" & seashell & "'>"
- Contents = Contents & vbCrLf & "<TD style='border-color:gray;width:70'><b>" & "Month" & "</b></TD>"
- arrTable(0, 0) = "<TD name='tableHeader' style='border-color:gray;width:70'><b>" & "Month" & "</b></TD>"
- 'First Row/col
- intYear = Year(Date)
- nextYear = intYear + 1
- k = 0
- LastRowOfTable = 0
- For i = StartMonth To EndMonth
- k = k + 1
- MonthInNumbers = i
- If i > 12 Then
- MonthInNumbers = i - 12
- intYear = nextYear
- End If
- 'Determine the last Row of the Table
- StrMonthStartsOnA = Weekday(CDate("1 " & MonthName(MonthInNumbers) & ", " & intYear), vbMonday)
- StrMonthEndsOnA = Day(DateSerial(intYear, i + 1, 0))
- LastRowOfMonth = StrMonthStartsOnA + StrMonthEndsOnA - 1
- If LastRowOfMonth > LastRowOfTable Then LastRowOfTable = LastRowOfMonth
- Contents = Contents & vbCrLf & "<TD style='border-color:gray;width:" & Int(100 / NbMonths) & "%'><b>" & MonthName(MonthInNumbers) & " " & intYear & "</b></TD>"
- arrTable(0, k) = "<TD name='tableHeader' style='border-color:gray;width:" & Int(100 / LastRowOfTable) & "%'><b>" & MonthName(MonthInNumbers) & " " & intYear & "</b></TD>"
- Next
- Contents = Contents & vbCrLf & "</TR>"
- If strEmptyCalendar = vbNo Then
- Set MyFolder = Cal.Items
- storeID = Cal.storeID
- MyFolder.IncludeRecurrences = True
- MyFolder.Sort "[Start]"
- 'create CDO session in order to get appointment label colors
- strProfileInfo = strServer & vbLf & Mbx
- 'You must add a Reference to Microsoft CDO version 1.21.
- On Error Resume Next
- Set objCDO = CreateObject("MAPI.Session")
- 'IMPORTANT: log on using a new MAPI session with a dynamically created profile
- 'we can't simply reuse the existing MAPI session -> script will not retrieve colors for all appointments
- objCDO.Logon "", "", False, True, 0, False, strProfileInfo & "rtrtrtr"
- ErrNum = Err.Number
- On Error GoTo 0
- If ErrNum <> 0 Then
- MsgBox "Could not create MAPI session to retrieve appointment colors. Will continue without colors."
- End If
- End If
- ...
- End Sub
Darüber hinaus habe ich es nicht getestet.--
If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
-- -
Sehe ich das richtig, dass das was du gepostet hast, einfach so in den vba outlook compilier reinpacken kann und es dann funktioniert? Entweder ist bei mir irgendetwas kaputt oder Outlook hasst mich
"Fehler Mehrdeutiger Name: ~" Ich flieg hier gleich vom Stuhl. Sorry, mit mir hast du echt eine schwere Geburt... -
Kleiner_VBAler schrieb:
einfach so in den vba outlook compilier reinpacken...
).
Kleiner_VBAler schrieb:
"Fehler Mehrdeutiger Name: ~"--
If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
-- -
ich habe den fehler gefunden... ay ay ay.. das ist vllt. ein Dreck
In deinem Code... Die Punkte ganz zum Schluss "..." Die waren es.. aber jetzt bekomme ich halt auch den Fehler, den du hattest, also den mit der MAPI Session und den Colors, liegt aber daran, dass bei dir der 3/4 des Codes fehlen, und so einfach inkludieren wird wohl nichts
@petaod soweit habe ich den rest jetzt wieder reingekopiert nachdem ich das ganze etwas bereinigt habe sagt er jetzt, dass mir der Zugriff verweigert wurde, in der Zeile hier:
<- ich weiß, es ist wahrscheinlich sehr zu spezifisch, aber vllt. weißt du da auch um rat. naja idealerweise wäre es gewesen, wenn du den kompletten code mal bei die getestest haettest bzw. testen würdest, dass du so Kleinigkeiten direkt raushauen kannst. Soll jetzt nicht heißen, dass ich nicht bereit bin etwas für eine Lösung zu tun.... Nur dauert das einfach selbst bei kleinen Problemen einfach fürchterlich lange und wie du sicherlich weißt bin ich mit diesem Problem schon seit fast einem Monat beschäftigt -.-
Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Kleiner_VBAler“ ()
-
Kleiner_VBAler schrieb:
Set F = filesys.OpenTextFile(strHtmlFile, ForWriting, True)
filesys ist ein gültiges FileSystemObject.
ForWriting ist eine Konstante mir dem Wert 2
strHtmlFile ist ein Dateipfad.
Mögliche Fehlerursachen:
- der Pfad zeigt auf ein Verzeichnis, das es nicht gibt.
- du hast keine Schreibberechtigung auf dieses Verzeichnis.
- der Pfad beinhaltet keinen Dateinamen.
- die Datei ist momentan von einem anderen Programm geöffnet.--
If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
-- -
- der Pfad zeigt auf ein Verzeichnis, das es nicht gibt. - kann ich ausschließen
- du hast keine Schreibberechtigung auf dieses Verzeichnis. - kann ich auch ausschließen
- der Pfad beinhaltet keinen Dateinamen. - ebenfalls.
- die Datei ist momentan von einem anderen Programm geöffnet. - Das weiß ich nicht, da ich überhaupt nicht verstehen kann, welches Programm denn noch das Script oder was auch immer aktuell verwendet?!
Zu den Punkten davor: Ich kann mir deshalb sicher sein, weil ich naemlich gerade das alte Ursprungsscript geöffnet habe (falls du erinnerst, das Script funktioniert ja wunderbar mit dem lokal angelegtem Kalender) und es mir wunderbar alle möglichen Ausgaben in einen bestimmten Ordner gepackt hat und im gleichen zu geöffnet hat. d.h., dass es dementsprechend nur der letzt Punkt sein kann. Keine Ahnung wie ich das testen soll... -
Kleiner_VBAler schrieb:
Keine Ahnung wie ich das testen soll...
technet.microsoft.com/en-us/sysinternals/bb896655
Alternativ:
technet.microsoft.com/en-us/sysinternals/bb896653
--
If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
-- -
-
Benutzer online 1
1 Besucher
-
Tags
-
Ähnliche Themen