Re: Read Exchange calendar with a VB script

anonymous_at_discussions.microsoft.com
Date: 03/31/04


Date: Wed, 31 Mar 2004 00:30:48 -0800

Hello Robert

Thanks for the hint. I thought it might be a permission
problem. Is there any other way to access the mailboxes
without having to set this permission? Maybe with another
script?

Marcel

>-----Original Message-----
>Using Exchange 2000/2003 the account executing the
script must have
>(explicit) receive as / send as permissions on each
mailbox store to open
>other mailboxes. Or add this account to the Exchange
Domain Servers group
>and to no ther group. If you can run the script as
LocalSystem on an
>Exchange Server you will already belong to the Exchange
Domain Servers group
>and have all required permissions.
>
>Good luck,
>Robert.
>
>
>"Marcel Graf" <marcel.graf@fgg.ch> schrieb im Newsbeitrag
>news:1411d01c41312$f2b6ecb0$a101280a@phx.gbl...
>Hello!
>
>In our enterprise we're entering holidays into our
>Outlook Calendar. To have a better overwiev over the
>holidays in our department we would like to make a
>holiday list.
>
>Now I'm looking for a way to access this data directly on
>the Exchange Server via CDO / MAPI with a VB-Script.
>
>I can already access my own calendar. But if I try these
>of my colleagues I get an error:
>
>Error -2147221219 You don't have the rights to log on
>
>
>
>This is the code I'm using:
>
>Sub GetData()
> Dim objSession As MAPI.Session
> Dim objFolder As MAPI.Folder
> Dim objMessages As MAPI.Messages
> Dim objMessage As MAPI.AppointmentItem
> Dim i, j As Integer
> Dim sUser As String
> Dim Kat(10) As Variant
>
> On Error GoTo error_GetData
>
> 'Get UserName
> sUser = CurrentUser()
>
> 'Open and validate Session
> Set objSession = CreateObject("MAPI.Session")
> If Not objSession Is Nothing Then
> objSession.Logon , , , , , , "\\CHSW0106" & vbLf
>& sUser
> End If
>
> 'Open Calendar folder and reference Appointment Items
> Set objFolder = objSession.GetDefaultFolder
>(CdoDefaultFolderCalendar)
> Set objMessages = objFolder.Messages
>
> i = 2
> For Each objMessage In objMessages ' loops and Sets
>each objMessage
> If Not IsEmpty(objMessage.Categories) Then 'Does
>Appointment have a category?
> For j = LBound(objMessage.Categories) To
>UBound(objMessage.Categories)
> ' Appointment not in the past?
> If 0 < Len(objMessage.Categories()(j))
>And objMessage.StartTime > Date Then
> Kat(1) = objMessage.Categories()(j)
> 'Selection of Categories to display
>and write to Excel ***
> If Kat(1) Like "Ferien" Or Kat(1)
>Like "Militär" Then
> Tabelle1.Cells(i, 1).Formula =
>objMessage.Subject
> Tabelle1.Cells(i, 2).Formula =
>objMessage.StartTime
> Tabelle1.Cells(i, 3).Formula =
>objMessage.EndTime
> i = i + 1
> End If
> End If
> Next j
> End If
> Next
>
> Exit Sub
>
>
>error_GetData:
>
>If 1273 = Err Then ' VB4.0: If Err.Number =
>CdoE_LOGON_FAILED Then
> MsgBox "Cannot log on. incorrect profile name or
>password. change global variable strProfileName in
>Util_Initialize"
> Exit Sub
>End If
>
>MsgBox "Error " & Str(Err) & ": " & Error$(Err)
>Resume Next
>
>
>End Sub
>
>
>Thanks in advance for every hint.
>
>
>.
>