Murray Brown
asked on
Excel VBA v VSTO Delete Outlook Appointment
I am trying to build a procedure in my Excel VB.net/VSTO add-in to delete an Outlook appointment.
I found the VBA code at the bottom and converted what I could but am not sure how to convert the following line:
"If oObject.Class = olAppointment Then"
I have marked the line with ???????
Public Sub DeleteAppointments(ByVal argSubject As String)
Dim oApp As Microsoft.Office.Interop.O utlook.App lication
Dim oNameSpace As Microsoft.Office.Interop.O utlook.Nam eSpace
Dim oApptItem As Microsoft.Office.Interop.O utlook.App ointmentIt em
Dim oFolder As Microsoft.Office.Interop.O utlook.MAP IFolder
Dim oMeetingoApptItem As Microsoft.Office.Interop.O utlook.Mee tingItem
Dim oObject As Object
Dim sErrorMessage As String
oApp = New Microsoft.Office.Interop.O utlook.App lication
System.Threading.Thread.Sl eep(3000) 'a bit of startup grace time.
On Error GoTo Err_Handler
oNameSpace = oApp.GetNamespace("MAPI")
oFolder = oNameSpace.GetDefaultFolde r(Microsof t.Office.I nterop.Out look.OlDef aultFolder s.olFolder Calendar)
For Each oObject In oFolder.Items
If oObject.Class = ??????? Then
oApptItem = oObject
If InStr(oApptItem.Subject, argSubject) > 0 Then
oApptItem.Delete()
End If
End If
Next oObject
oApp = Nothing
oNameSpace = Nothing
oApptItem = Nothing
oFolder = Nothing
oObject = Nothing
Exit Sub
Err_Handler:
sErrorMessage = Err.Number & " " & Err.Description
End Sub
Option Explicit
Option Compare Text
Public Sub Driver()
Call DeleteAppointments("wibble ")
End Sub
Public Sub DeleteAppointments(ByVal argSubject As String)
Dim oApp As Outlook.Application
Dim oNameSpace As Outlook.Namespace
Dim oApptItem As Outlook.AppointmentItem
Dim oFolder As Outlook.MAPIFolder
Dim oMeetingoApptItem As Outlook.MeetingItem
Dim oObject As Object
Dim iUserReply As VbMsgBoxResult
Dim sErrorMessage As String
On Error Resume Next
' check if Outlook is running
Set oApp = GetObject("Outlook.Applica tion")
If Err <> 0 Then
'if not running, start it
Set oApp = CreateObject("Outlook.Appl ication")
End If
On Error GoTo Err_Handler
Set oNameSpace = oApp.GetNamespace("MAPI")
Set oFolder = oNameSpace.GetDefaultFolde r(olFolder Calendar)
For Each oObject In oFolder.Items
If oObject.Class = olAppointment Then
Set oApptItem = oObject
If InStr(oApptItem.Subject, argSubject) > 0 Then
iUserReply = MsgBox("Appointment found:-" & vbCrLf & vbCrLf _
& Space(4) & "Date/time: " & Format(oApptItem.Start, "dd/mm/yyyy hh:nn") _
& " (" & oApptItem.Duration & "mins)" & Space(10) & vbCrLf _
& Space(4) & "Subject: " & oApptItem.Subject & Space(10) & vbCrLf _
& Space(4) & "Location: " & oApptItem.Location & Space(10) & vbCrLf & vbCrLf _
& "Delete this appointment?", vbYesNo + vbQuestion + vbDefaultButton2, "Delete Appointment?")
If iUserReply = vbYes Then oApptItem.Delete
End If
End If
Next oObject
Set oApp = Nothing
Set oNameSpace = Nothing
Set oApptItem = Nothing
Set oFolder = Nothing
Set oObject = Nothing
Exit Sub
Err_Handler:
sErrorMessage = Err.Number & " " & Err.Description
End Sub
I found the VBA code at the bottom and converted what I could but am not sure how to convert the following line:
"If oObject.Class = olAppointment Then"
I have marked the line with ???????
Public Sub DeleteAppointments(ByVal argSubject As String)
Dim oApp As Microsoft.Office.Interop.O
Dim oNameSpace As Microsoft.Office.Interop.O
Dim oApptItem As Microsoft.Office.Interop.O
Dim oFolder As Microsoft.Office.Interop.O
Dim oMeetingoApptItem As Microsoft.Office.Interop.O
Dim oObject As Object
Dim sErrorMessage As String
oApp = New Microsoft.Office.Interop.O
System.Threading.Thread.Sl
On Error GoTo Err_Handler
oNameSpace = oApp.GetNamespace("MAPI")
oFolder = oNameSpace.GetDefaultFolde
For Each oObject In oFolder.Items
If oObject.Class = ??????? Then
oApptItem = oObject
If InStr(oApptItem.Subject, argSubject) > 0 Then
oApptItem.Delete()
End If
End If
Next oObject
oApp = Nothing
oNameSpace = Nothing
oApptItem = Nothing
oFolder = Nothing
oObject = Nothing
Exit Sub
Err_Handler:
sErrorMessage = Err.Number & " " & Err.Description
End Sub
Option Explicit
Option Compare Text
Public Sub Driver()
Call DeleteAppointments("wibble
End Sub
Public Sub DeleteAppointments(ByVal argSubject As String)
Dim oApp As Outlook.Application
Dim oNameSpace As Outlook.Namespace
Dim oApptItem As Outlook.AppointmentItem
Dim oFolder As Outlook.MAPIFolder
Dim oMeetingoApptItem As Outlook.MeetingItem
Dim oObject As Object
Dim iUserReply As VbMsgBoxResult
Dim sErrorMessage As String
On Error Resume Next
' check if Outlook is running
Set oApp = GetObject("Outlook.Applica
If Err <> 0 Then
'if not running, start it
Set oApp = CreateObject("Outlook.Appl
End If
On Error GoTo Err_Handler
Set oNameSpace = oApp.GetNamespace("MAPI")
Set oFolder = oNameSpace.GetDefaultFolde
For Each oObject In oFolder.Items
If oObject.Class = olAppointment Then
Set oApptItem = oObject
If InStr(oApptItem.Subject, argSubject) > 0 Then
iUserReply = MsgBox("Appointment found:-" & vbCrLf & vbCrLf _
& Space(4) & "Date/time: " & Format(oApptItem.Start, "dd/mm/yyyy hh:nn") _
& " (" & oApptItem.Duration & "mins)" & Space(10) & vbCrLf _
& Space(4) & "Subject: " & oApptItem.Subject & Space(10) & vbCrLf _
& Space(4) & "Location: " & oApptItem.Location & Space(10) & vbCrLf & vbCrLf _
& "Delete this appointment?", vbYesNo + vbQuestion + vbDefaultButton2, "Delete Appointment?")
If iUserReply = vbYes Then oApptItem.Delete
End If
End If
Next oObject
Set oApp = Nothing
Set oNameSpace = Nothing
Set oApptItem = Nothing
Set oFolder = Nothing
Set oObject = Nothing
Exit Sub
Err_Handler:
sErrorMessage = Err.Number & " " & Err.Description
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.
ASKER