jjh2010
asked on
How do I reference a calendar other than the default calendar?
I am exporting the events from one day into a table in a Word document. I have not found a way to reference a calendar at the root of a mailbox besides the default calendar. Every method I find online doesn't quite work. Here are the lines that I think need to be changed:
Set wrdDoc = wrdApp.Documents.Add
Set MyOutlookNS = GetNamespace("MAPI")
Set myItems = MyOutlookNS.GetDefaultFold er(olFolde rCalendar) .Items
i know this code is not documented well, somewhat messy, and it is probably not wise to put so much code under a button click. The only part that is really of concern for this question is the beginning from the Dim statements through the Set statements.
Set wrdDoc = wrdApp.Documents.Add
Set MyOutlookNS = GetNamespace("MAPI")
Set myItems = MyOutlookNS.GetDefaultFold
i know this code is not documented well, somewhat messy, and it is probably not wise to put so much code under a button click. The only part that is really of concern for this question is the beginning from the Dim statements through the Set statements.
Private Sub CommandButton1_Click()
Dim MyOutlookNS As Outlook.NameSpace
Dim targetDate As Date
Dim comparisonDate As Date
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim myItems As Outlook.Items
Dim myRange As Range
Dim X, Y As Integer
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Add
Set MyOutlookNS = GetNamespace("MAPI")
Set myItems = MyOutlookNS.GetDefaultFolder(olFolderCalendar).Items
Set myRange = wrdDoc.Content
targetDate = Now
myItems.Sort "[Start]", False
wrdDoc.Paragraphs.SpaceAfterAuto = 0
wrdDoc.Paragraphs.Format.SpaceAfter = 0
wrdDoc.Paragraphs.LineSpacingRule = wdLineSpaceSingle
With myRange
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Font.Size = 24
.Font.Bold = True
.InsertAfter targetDate & vbCrLf
.Collapse wdCollapseEnd
.Tables.Add myRange, 1, 2
.Tables(1).TopPadding = 0
.Tables(1).BottomPadding = 0
.Tables(1).LeftPadding = 0
.Tables(1).RightPadding = 0
.Tables(1).Spacing = 0
X = 1
Y = 1
For Each MyAppt In myItems
comparisonDate = MyAppt.Start
If Mid(comparisonDate, 1, 9) = Mid(targetDate, 1, 9) Then
.Tables(1).Cell(X, Y).Range.Text = Format(MyAppt.Start, "Medium Time") & " - " & Format(MyAppt.End, "Medium Time")
.Font.Bold = True
.Tables(1).Cell(X, Y + 1).Range.Text = MyAppt.Subject & " - " & MyAppt.Location & vbCrLf & MyAppt.Body
.Tables(1).Rows.Add
X = X + 1
End If
Next
.Tables(1).Rows.Last.Delete
End With
wrdApp.Visible = True
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.