Bei Outlook "Freigegebene Kalender" ansprechen und nicht die StandardMAPI

  • Outlook

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 Punkt Set 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 :P
    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

    1. Sub Test()
    2. DisplayYearlyCalendar SharedCalender("user@mydomain.com")
    3. End Sub
    4. Function SharedCalender(ByVal MailAddress As String) As Object
    5. Dim NS As Outlook.NameSpace
    6. Dim Owner As Outlook.Recipient
    7. On Error GoTo Done
    8. Set MAPI = Application.GetNamespace("MAPI")
    9. Set Owner = MAPI.CreateRecipient(MailAddress)
    10. Owner.Resolve
    11. If Owner.Resolved Then Set SharedCalender = MAPI.GetSharedDefaultFolder(Owner, olFolderCalendar)
    12. Done:
    13. End Function
    14. Sub DisplayYearlyCalendar(ByVal Cal As Object)
    15. Const ForWriting = 2
    16. Dim Mbx As String, Shell As Object, FS As Object, Folder As String
    17. Set Shell = CreateObject("WScript.Shell")
    18. Set FS = CreateObject("Scripting.FileSystemObject")
    19. Folder = Shell.ExpandEnvironmentStrings("%TEMP%") & "\YearCalendar"
    20. If Not FS.FolderExists(Folder) Then FS.CreateFolder Folder
    21. 'Set OL = CreateObject("Outlook.Application") 'external
    22. Set OL = Application 'outlook internal
    23. Set MAPI = OL.GetNamespace("MAPI")
    24. Mbx = Replace(Replace(Cal.Parent.Name, "Mailbox - ", ""), "Postfach - ", "")
    25. Server = GetExchangeServer(Mbx)
    26. 'FILTER CATEGORIES
    27. 'list here the categories that you want to hide
    28. arrExcludeCategories = Array()
    29. 'arrExcludeCategories = Array("Personal", "StaffMeetings")
    30. 'HIDE PRIVATE APPOINTMENTS
    31. 'Set this to TRUE if you want to display private appointments
    32. Const blShowPrivateAppointments = True
    33. 'ALIGN BY WEEKDAY / DAY-OF-MONTH
    34. '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)
    35. Const blAlignWeekDays = True
    36. 'ONLY ALL-DAY-EVENTS
    37. 'Set this to TRUE if you want to display AllDayEvents only
    38. blAllDayEventsOnly = False
    39. 'COLORS used
    40. 'colors from http://web.njit.edu/~kevin/rgb.txt.html
    41. Const wheat_light = "#EED8AE"
    42. Const wheat_dark = "#CDBA96"
    43. Const seashell = "#EEE5DE"
    44. Const silver = "#C0C0C0"
    45. Const cornsilk = "#FFF8DC"
    48. 'NAME AND LOCATION OF HTML OUTPUT FILES
    49. strHtmlFile = strTempFolder & "\YearlyCalendar.html"
    50. strHtmlFileTransposed = strTempFolder & "\YearlyCalendarTransposed.html"
    51. strHtmlFile7Columns = strTempFolder & "\YearlyCalendar7Columns.html"
    53. 'SCRIPT BEGIN
    54. 'ASKING FOR TIMESPAN TO BE DISPLAYED
    55. 'ENTER 13 for next January etc.
    56. StartMonth = InputBox("Start Month", "Start Month", Month(Date))
    57. If StartMonth = "" Then Exit Sub
    58. StartMonth = CInt(StartMonth)
    60. EndMonth = InputBox("End Month", "End Month", StartMonth - 1)
    61. If EndMonth = "" Then Exit Sub
    62. EndMonth = CInt(EndMonth)
    64. If EndMonth < StartMonth Then
    65. NbMonths = EndMonth - StartMonth + 13
    66. EndMonth = EndMonth + 12
    67. Else
    68. NbMonths = EndMonth - StartMonth + 1
    69. End If
    71. 'DISPLAY EMPTY CALENDAR?
    72. strEmptyCalendar = vbNo
    73. 'strEmptyCalendar = MsgBox("Empty Calendar?", vbYesNo + vbDefaultButton2)
    74. Dim arrTable(100, 100) 'array used to created the transposed version of the calendar
    76. 'Create Table: 1 Header Row
    77. ' 7 days x 5 weeks = 35 day rows
    78. ' 1 Header column
    79. ' 1 column for each month
    81. strHeader = "<head><title>Yearly Calendar</title></head>"
    82. 'NOTE: We are trying to use the available space efficiently to put all appointments on one sheet of paper
    83. 'You should play around with the "font-size:50%" bit, depending on how packed your calendar is
    84. 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'>"
    85. 'header row
    86. Contents = Contents & vbCrLf & "<TR valign='top' bgcolor='" & seashell & "'>"
    87. Contents = Contents & vbCrLf & "<TD style='border-color:gray;width:70'><b>" & "Month" & "</b></TD>"
    88. arrTable(0, 0) = "<TD name='tableHeader' style='border-color:gray;width:70'><b>" & "Month" & "</b></TD>"
    90. 'First Row/col
    91. intYear = Year(Date)
    92. nextYear = intYear + 1
    93. k = 0
    94. LastRowOfTable = 0
    95. For i = StartMonth To EndMonth
    96. k = k + 1
    97. MonthInNumbers = i
    98. If i > 12 Then
    99. MonthInNumbers = i - 12
    100. intYear = nextYear
    101. End If
    102. 'Determine the last Row of the Table
    103. StrMonthStartsOnA = Weekday(CDate("1 " & MonthName(MonthInNumbers) & ", " & intYear), vbMonday)
    104. StrMonthEndsOnA = Day(DateSerial(intYear, i + 1, 0))
    105. LastRowOfMonth = StrMonthStartsOnA + StrMonthEndsOnA - 1
    106. If LastRowOfMonth > LastRowOfTable Then LastRowOfTable = LastRowOfMonth
    107. Contents = Contents & vbCrLf & "<TD style='border-color:gray;width:" & Int(100 / NbMonths) & "%'><b>" & MonthName(MonthInNumbers) & " " & intYear & "</b></TD>"
    108. arrTable(0, k) = "<TD name='tableHeader' style='border-color:gray;width:" & Int(100 / LastRowOfTable) & "%'><b>" & MonthName(MonthInNumbers) & " " & intYear & "</b></TD>"
    109. Next
    110. Contents = Contents & vbCrLf & "</TR>"
    112. If strEmptyCalendar = vbNo Then
    113. Set MyFolder = Cal.Items
    114. storeID = Cal.storeID
    116. MyFolder.IncludeRecurrences = True
    117. MyFolder.Sort "[Start]"
    119. 'create CDO session in order to get appointment label colors
    120. strProfileInfo = strServer & vbLf & Mbx
    122. 'You must add a Reference to Microsoft CDO version 1.21.
    124. On Error Resume Next
    125. Set objCDO = CreateObject("MAPI.Session")
    126. 'IMPORTANT: log on using a new MAPI session with a dynamically created profile
    127. 'we can't simply reuse the existing MAPI session -> script will not retrieve colors for all appointments
    128. objCDO.Logon "", "", False, True, 0, False, strProfileInfo & "rtrtrtr"
    129. ErrNum = Err.Number
    130. On Error GoTo 0
    131. If ErrNum <> 0 Then
    132. MsgBox "Could not create MAPI session to retrieve appointment colors. Will continue without colors."
    133. End If
    135. End If
    136. ...
    137. End Sub
    Bis hierher läuft's ohne Abstürze.
    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: ~" :D Ich flieg hier gleich vom Stuhl. Sorry, mit mir hast du echt eine schwere Geburt...

    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:

    Visual Basic-Quellcode

    1. Set F = filesys.OpenTextFile(strHtmlFile, ForWriting, True)
    <- 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)
    Annahme:
    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...

    Tja, dann war es das an dieser Stelle mit der Odysee von VBA... Administratorische Rechte habe ich hier leider nicht, zumindest nicht da, wo ich auch den Exchange-Server dran hab und kann somit das nette Tool nicht ausführen. :( Ich werde hier noch wahnsinning.

Facebook
Telefonspende