View Single Post
  #3  
Old January 18th 07, 03:30 PM posted to microsoft.public.outlook.program_vba
Ken Slovak - [MVP - Outlook]
external usenet poster
 
Posts: 5,848
Default Check if appointment exists ( by subject ) in Outlook from Excel VBA

You can get the Items collection for the default Calendar folder using
NameSpace.GetDefaultFolder(olFolderCalendar) and then getting the Items
collection for that folder. Once you have that you can filter or restrict
the Items collection based on Subject.

See the Help for Items.Restrict, it has some sample code showing how to
restrict the original Items collection to a filtered Items collection that
will only have items with that subject. Alternatively you can set the filter
string and use Find and FindNext to iterate the original Items collection
using the filter.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Bart" wrote in message
ups.com...
Hello there,

I am quite new to VBA and wrote a litte code to make an appointment in
outlook from excel, I added a CommandBarControl in excel so users only
have to right click a cell, choose the new 'Update Outlook' button and
it will then fetch all data from the row the cell is in to create the
appointment ( used with a container delivery status overview in excel
) with all delivery details etc. :

[code]

Private Sub Workbook_Open()
Dim NewControl As CommandBarControl
On Error Resume Next
Application.CommandBars("Cell").Controls("Update
Outlook").Delete
On Error GoTo 0
Set NewControl = Application.CommandBars("Cell").Controls.Add
With NewControl
.Caption = "Update Outlook"
.OnAction = "OutlookUpdate.Update"
.BeginGroup = True
End With
End Sub


Sub Update()
' Turn off screen updating
Application.ScreenUpdating = False

' Start Outlook
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

' Logon
Dim olNs As Outlook.NameSpace
Set olNs = olApp.GetNamespace("MAPI")
olNs.Logon

' Create a new appointment
Dim arrival As Date
arrival = ActiveWorkbook.Worksheets(1).Range("E" &
ActiveCell.Row).Value + ActiveWorkbook.Worksheets(1).Range("F" &
ActiveCell.Row).Value

Dim olAppt As Outlook.AppointmentItem
Set olAppt = olApp.CreateItem(olAppointmentItem)

' Check with user if selected row is correct
Msg = "Update GRN " & ActiveWorkbook.Worksheets(1).Range("A" &
ActiveCell.Row).Value & " ?"
Ans = MsgBox(Msg, vbYesNo)
If Ans = vbNo Then Exit Sub

' Check if date is entered
If Trim(Range("E" & ActiveCell.Row).Value) = "" Then
MsgBox "Enter an arrival date !"
Exit Sub
End If

' Check if time is entered
If Trim(Range("F" & ActiveCell.Row).Value) = "" Then
MsgBox "Enter an arrival time !"
Exit Sub
End If

' Check if duration is entered
If Trim(Range("G" & ActiveCell.Row).Value) = "" Then
MsgBox "Enter a duration !"
Exit Sub
End If

' Setup appointment ...
With olAppt
.Start = arrival
.Duration = ActiveWorkbook.Worksheets(1).Range("G" &
ActiveCell.Row).Value
.Subject = ActiveWorkbook.Worksheets(1).Range("A" &
ActiveCell.Row).Value _
& " - " & ActiveWorkbook.Worksheets(1).Range("B" &
ActiveCell.Row).Value _
& " - " & ActiveWorkbook.Worksheets(1).Range("I" &
ActiveCell.Row).Value
.Body = "Container delivery from : " &
ActiveWorkbook.Worksheets(1).Range("B" & ActiveCell.Row).Value _
& vbCrLf & "GRN : " &
ActiveWorkbook.Worksheets(1).Range("A" & ActiveCell.Row).Value _
& vbCrLf & "Invoice : " &
ActiveWorkbook.Worksheets(1).Range("C" & ActiveCell.Row).Value _
& vbCrLf & "Date & Time of arrival : " &
ActiveWorkbook.Worksheets(1).Range("E" & ActiveCell.Row).Value +
ActiveWorkbook.Worksheets(1).Range("F" & ActiveCell.Row).Value _
& vbCrLf & "Cont. Nr. : " &
ActiveWorkbook.Worksheets(1).Range("I" & ActiveCell.Row).Value
.ReminderSet = True
.ReminderMinutesBeforeStart = 1480
End With

' Save Appointment...
olAppt.Save

' Turn screen updating back on
Application.ScreenUpdating = True

' Clean up...
' MsgBox "GRN " & ActiveWorkbook.Worksheets(1).Range("A" &
ActiveCell.Row).Value & " is synchronized with Outlook...",
vbMsgBoxSetForeground
olNs.Logoff
Set olNs = Nothing
Set olAppt = Nothing
Set olItem = Nothing
Set olApp = Nothing
End Sub

[ /code]

Now, this all works fine, but the problem is that dates are altered
when the status changes and that is why I want to build in a check if
the appointment is present, and if so, make sure it gets deleted and
then added again with the new data.

The subject of the appointment is a unique combination of different
fields, so I would like to use the subject to find a match and if
found, delete that match and then re-enter the new appointment.

I really don't know where or what to start with, so any help / tip is
welcome.

Many thanks in advance,
Bart


Ads