OS: XP Professional
Office 2003 (no Exchange)

The quick description: I've got a .xls file with 6 fields: 'Start Date',
'End Date', 'Start Time', 'End Time', 'Subject' and 'Description'. I'd like
to programatically import this into an Outlook Calendar . I can do it
manually with File - Import/Export - From program/file - xls Windows -
Tell it the file, force duplicates to be overwritten, hit ok, job done. I
need the code to do this automatically, which I can then run from the
desktop. (Like the Access command '/x macroname')

I know it can probably be done using Office automation from the original
excel macro, but I'd like to keep it seperate, whenever the users opening the
outlook it should run as a background process and update calendar entries
from that particular file

Can anyone help? I'm open to alternative suggestions if absolutely necessary
Thanks.
Vaisakh

Coincidentally, and contrarily, I'm looking to do the reverse -- I have been
tasked with automating a process to extract those very same fields from
outlook, for a defined date range, into excel, and it needs to be via a
macro, push of a button, whatever.

Any ideas?

"Vaisakh M S" wrote:

OS: XP Professional
Office 2003 (no Exchange)

The quick description: I've got a .xls file with 6 fields: 'Start Date',
'End Date', 'Start Time', 'End Time', 'Subject' and 'Description'. I'd like
to programatically import this into an Outlook Calendar . I can do it
manually with File - Import/Export - From program/file - xls Windows -
Tell it the file, force duplicates to be overwritten, hit ok, job done. I
need the code to do this automatically, which I can then run from the
desktop. (Like the Access command '/x macroname')

I know it can probably be done using Office automation from the original
excel macro, but I'd like to keep it seperate, whenever the users opening the
outlook it should run as a background process and update calendar entries
from that particular file

Can anyone help? I'm open to alternative suggestions if absolutely necessary
Thanks.
Vaisakh

Paste this code into a standard module in Excel. You will need to
adapt it for your particular needs, however. Run the
GetApptsFromOutlook() sub and adjust the dates accordingly. You will
also need to set a reference to the Outlook object library and
(optionally) have Outlook open when running the code.

Enjoy,
JP


Option Explicit

Sub GetApptsFromOutlook()
Application.ScreenUpdating = False
Call GetCalData("7/14/2008", "7/25/2008")
Application.ScreenUpdating = True
End Sub

Private Sub GetCalData(StartDate As Date, Optional EndDate As Date)

' -------------------------------------------------
' Notes:
' If Outlook is not open, it still works, but much slower (~8 secs vs.
2 secs w/ Outlook open).
' Make sure to reference the Outlook object library before running the
code
' End Date is optional, if you want to pull from only one day, use:
Call GetCalData("7/14/2008")
' -------------------------------------------------

Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim myCalItems As Outlook.Items
Dim ItemstoCheck As Outlook.Items
Dim ThisAppt As Outlook.AppointmentItem

Dim MyItem As Object

Dim StringToCheck As String

Dim MyBook As Excel.Workbook
Dim rngStart As Excel.Range

Dim i As Long
Dim NextRow As Long

' if no end date was specified, then the requestor only wants one day,
so set EndDate = StartDate
' this will let us return appts from multiple dates, if the requestor
does in fact set an appropriate end date
If EndDate = "12:00:00 AM" Then
EndDate = StartDate
End If

If EndDate StartDate Then
MsgBox "Those dates seem switched, please check them and try
again.", vbInformation
GoTo ExitProc
End If

If EndDate - StartDate 28 Then
' ask if the requestor wants so much info
If MsgBox("This could take some time. Continue anyway?",
vbInformation + vbYesNo) = vbNo Then
GoTo ExitProc
End If
End If

' get or create Outlook object and make sure it exists before
continuing
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number 0 Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Cannot start Outlook.", vbExclamation
GoTo ExitProc
End If

Set olNS = olApp.GetNamespace("MAPI")
Set myCalItems = olNS.GetDefaultFolder(olFolderCalendar).Items

' ------------------------------------------------------------------
' the following code adapted from:
' http://www.outlookcode.com/article.aspx?id=30
' http://weblogs.asp.net/whaggard/arch...ate-range.aspx
'
With myCalItems
.Sort "[Start]", False
.IncludeRecurrences = True
End With
'
StringToCheck = "[Start] = " & Quote(StartDate & " 12:00 AM") & " AND
[End] = " & Quote(EndDate & " 11:59 PM")
Debug.Print StringToCheck
'
Set ItemstoCheck = myCalItems.Restrict(StringToCheck)
Debug.Print ItemstoCheck.count
' ------------------------------------------------------------------

If ItemstoCheck.count 0 Then
' we found at least one appt

Set MyBook = Excel.Workbooks.Add
Set rngStart = MyBook.Sheets(1).Range("A1")

With rngStart
.Offset(0, 0).Value = "Subject"
.Offset(0, 1).Value = "Start Date"
.Offset(0, 2).Value = "Start Time"
.Offset(0, 3).Value = "End Date"
.Offset(0, 4).Value = "End Time"
.Offset(0, 5).Value = "Location"
.Offset(0, 6).Value = "Categories"
End With

For Each MyItem In ItemstoCheck
If MyItem.Class = olAppointment Then
' MyItem is the appointment or meeting item we want
' set obj reference to it
Set ThisAppt = MyItem
NextRow = WorksheetFunction.CountA(Range("A:A"))

With rngStart
.End(xlDown).End(xlUp).Offset(NextRow, 0).Value =
ThisAppt.Subject
.End(xlDown).End(xlUp).Offset(NextRow, 1).Value =
Format(ThisAppt.Start, "MM/DD/YYYY")
.End(xlDown).End(xlUp).Offset(NextRow, 2).Value =
Format(ThisAppt.Start, "HH:MM AM/PM")
.End(xlDown).End(xlUp).Offset(NextRow, 3).Value =
Format(ThisAppt.End, "MM/DD/YYYY")
.End(xlDown).End(xlUp).Offset(NextRow, 4).Value =
Format(ThisAppt.End, "HH:MM AM/PM")
.End(xlDown).End(xlUp).Offset(NextRow, 5).Value =
ThisAppt.Location

If ThisAppt.Categories "" Then
.End(xlDown).End(xlUp).Offset(NextRow,
6).Value = ThisAppt.Categories
Else
.End(xlDown).End(xlUp).Offset(NextRow,
6).Value = "n/a"
End If
End With
End If
Next MyItem


Else
MsgBox "There are no appointments or meetings during the time you
specified. Exiting now.", vbCritical
End If

ExitProc:
Set myCalItems = Nothing
Set ItemstoCheck = Nothing
Set olNS = Nothing
Set olApp = Nothing
Set rngStart = Nothing
Set ThisAppt = Nothing
End Sub

Private Function Quote(MyText)
' from Sue Mosher's excellent book "Microsoft Outlook Programming"
Quote = Chr(34) & MyText & Chr(34)
End Function



On Jul 15, 10:06*am, CPOjoe wrote:
Coincidentally, and contrarily, I'm looking to do the reverse -- I have been
tasked with automating a process to extract those very same fields from
outlook, for a defined date range, into excel, and it needs to be via a
macro, push of a button, whatever.

Any ideas?