Import calendar data from MS Outlook

[AlfD]

Hi!

I'm able to get the calendar data out of Outlook and into an Exce
spreadsheet and to organise it by categories etc and to add a colum
showing duration of appointments (End time - Start time) and henc
analyse time against category.

That's the output I want.

Is there, however, a way of streamlining this? While I am happy to edi
the spreadsheet when using it myself, my wife's colleagues (for it i
they who need the tool) have varying levels of excel - lence.

I don't know Outlook very well: the Help files don't help much. I'v
tried a Google search but probably my ignorance of Outlook didn'
help.

Maybe my answer lies in an Outlook ng - but I hope not.

It would be nice if Outlook could export "Duration". Otherwise, perhap
I'll have to import it into a template or slip in a macro...

Help would be appreciated.

Al

 

[Bob Phillips]

Alf,

Here's some code

Sub ListOutlookCalendar()
Dim oOlApp As Object 'Outlook.Application
Dim oNameSpace As Object 'NameSpace
Dim oFolder As Object 'MAPIFolder
Dim oAppt As Object 'AppointmentItem
Dim i As Long

On Error Resume Next
Worksheets.Add.Name = "Appointments"
Set oOlApp = GetObject(, "Outlook.Application")
On Error GoTo 0

If oOlApp Is Nothing Then
Set oOlApp = CreateObject("Outlook.Application")
End If
Set oNameSpace = oOlApp.GetNamespace("MAPI")
Set oFolder = oNameSpace.GetDefaultFolder(9)

With Worksheets("Appointments")
.Cells.Clear
.Cells(1, "A").Value = "Subjcet"
.Cells(1, "B").Value = "Start Date"
.Cells(1, "C").Value = "Duration"
.Cells(1, "A").Resize(1, 3).Font.Bold = True
For Each oAppt In oFolder.Items
i = i + 1
.Cells(i + 1, "A").Value = oAppt.Subject
.Cells(i + 1, "B").Value = Format(oAppt.Start, "dd mmm yyyy
hh:mm")
.Cells(i + 1, "C").Value = Format(oAppt.End, "dd mmm yyyy
hh:mm")
Next oAppt
.Cells(1, "A").Columns.AutoFit
End With

Set oAppt = Nothing
Set oFolder = Nothing
Set oNameSpace = Nothing
Set oAppt = Nothing

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[AlfD]

Hi Bob!

I'm most grateful for your code.

It got me going and led to the following (which I have only run on m
own diary at present, but to good effect). Just a few non-cosmeti
alterations among the rest.

Many thanks!

Alf

Sub ListOutlookCalendar() ' Courtesy of Bob Phillips
Dim oOlApp As Object 'Outlook.Application
Dim oNameSpace As Object 'NameSpace
Dim oFolder As Object 'MAPIFolder
Dim oAppt As Object 'AppointmentItem
Dim i As Long

On Error Resume Next
Worksheets.Add.Name = "Appointments"
Set oOlApp = GetObject(, "Outlook.Application")
On Error GoTo 0

If oOlApp Is Nothing Then
Set oOlApp = CreateObject("Outlook.Application")
End If
Set oNameSpace = oOlApp.GetNamespace("MAPI")
Set oFolder = oNameSpace.GetDefaultFolder(9)

With Worksheets("Appointments")
.Cells.Clear
.Cells(1, "A").Value = "Subject"
.Cells(1, "B").Value = "Start Date / Time"
.Cells(1, "C").Value = "End Date /Time"
.Cells(1, "D").Value = "Categories"
.Cells(1, "E").Value = "Duration"
.Cells(1, "F").Value = "Hours as decimal"
.Cells(1, "A").Resize(1, 6).Font.Bold = True
For Each oAppt In oFolder.Items
i = i + 1
.Cells(i + 1, "A").Value = oAppt.Subject
.Cells(i + 1, "B").Value = Format(oAppt.Start, "dd mmm yyyy hh: mm ")
.Cells(i + 1, "C").Value = Format(oAppt.End, "dd mmm yyyy hh: mm ")
.Cells(i + 1, "D").Value = oAppt.Categories
.Cells(i + 1, "E").Value = Format(.Cells(i + 1, "C").Value - .Cells(i
1, "B").Value, "hh:mm")
.Cells(i + 1, "F").Value = .Cells(i + 1, "E").Value * 24
Next oAppt
.Columns("A:F").AutoFit

End With

Set oAppt = Nothing
Set oFolder = Nothing
Set oNameSpace = Nothing
Set oAppt = Nothing

End Su

 

[AussieM8]

OK, I've been following this thread and would like to know how I can g
about importing data from sub-folders within outlook.

Eg. rather than use the default folders, get data from somethin
like:

Inbox
Folder1 <==== how would you get this data?
Folder2


From reading somewhere, I've tried to use this method without success.

Set oFolder = oNameSpace.Folders("Persona
Folders").Folders("Inbox").Folders("Folder1")

Running W2K.

Any help would be appreciated.
Thanks

 

[AlfD]

Hi!

No bites, as yet. I can't help - like you I am on new ground.
Wonder if the Outlook forums or ngs can help?
I'd be interested in the outcome, too.

Al