J
James
This is what I have now but it will not find an entry in outlook. If I
delete the item and then hit the btnOutlook it will add the Entry. If the
Entry is there it doesn't do anything. How do I tell where it is messing up
at? I don't understand how to walk through the steps. I put the I beam
cursor at the begining of each line and then hit the "step to cursor"
button. All of the lines were fine except the blank line and all of the
"Dim" lines. They all said: Line is not an exacutable statement.
Private Sub btnOutlook_Click()
On Error GoTo Err_btnOutlook_Click
Dim objOApp As New Outlook.Application
Dim objAppt As AppointmentItem
Dim oExp As Outlook.Explorer
Dim i As Long
Dim j As Long
Dim oItems As Outlook.Items
Dim oFilter As Outlook.Items
Dim sEventID As String
Set oItems = objOApp.Session.GetDefaultFolder(olFolderCalendar).Items
sEventID = Forms![Events]!EventID
Set oFilter = oItems.Restrict("[Subject] = '" & sEventID & "'")
Set objOApp = New Outlook.Application
Set objAppt = objOApp.CreateItem(olAppointmentItem)
Set oExp = objOApp.Session.GetDefaultFolder(olFolderInbox).GetExplorer
If oFilter.Count > 0 Then
'item already exists with that value
j = oFilter.Count
For i = j To 1 Step -1
Set oAppt = oFilter(i)
objAppt.Delete
Next i
Else
With objAppt
.ReminderOverrideDefault = True
.ReminderSet = True
.ReminderMinutesBeforeStart = 1440 '1 Day
.Subject = EventID
.Importance = 2 ' high
.Start = PUDate
.End = DODate
.Body = PULocation & " - " & DOLocation & " - " & Notes & " - "
& EventDescription
.MeetingStatus = 1
.ResponseRequested = False
.Save 'Comment out if you do not want message saved to your
sent items folder
.Send
MsgBox "The event has been sent."
End With
End If
Set objOApp = Nothing
Set objAppt = Nothing
Set oExp = Nothing
Set oItems = Nothing
Set oFilter = Nothing
Exit_btnOutlook_Click:
Exit Sub
Err_btnOutlook_Click:
MsgBox Err.Description
Resume Exit_btnOutlook_Click
End Sub
delete the item and then hit the btnOutlook it will add the Entry. If the
Entry is there it doesn't do anything. How do I tell where it is messing up
at? I don't understand how to walk through the steps. I put the I beam
cursor at the begining of each line and then hit the "step to cursor"
button. All of the lines were fine except the blank line and all of the
"Dim" lines. They all said: Line is not an exacutable statement.
Private Sub btnOutlook_Click()
On Error GoTo Err_btnOutlook_Click
Dim objOApp As New Outlook.Application
Dim objAppt As AppointmentItem
Dim oExp As Outlook.Explorer
Dim i As Long
Dim j As Long
Dim oItems As Outlook.Items
Dim oFilter As Outlook.Items
Dim sEventID As String
Set oItems = objOApp.Session.GetDefaultFolder(olFolderCalendar).Items
sEventID = Forms![Events]!EventID
Set oFilter = oItems.Restrict("[Subject] = '" & sEventID & "'")
Set objOApp = New Outlook.Application
Set objAppt = objOApp.CreateItem(olAppointmentItem)
Set oExp = objOApp.Session.GetDefaultFolder(olFolderInbox).GetExplorer
If oFilter.Count > 0 Then
'item already exists with that value
j = oFilter.Count
For i = j To 1 Step -1
Set oAppt = oFilter(i)
objAppt.Delete
Next i
Else
With objAppt
.ReminderOverrideDefault = True
.ReminderSet = True
.ReminderMinutesBeforeStart = 1440 '1 Day
.Subject = EventID
.Importance = 2 ' high
.Start = PUDate
.End = DODate
.Body = PULocation & " - " & DOLocation & " - " & Notes & " - "
& EventDescription
.MeetingStatus = 1
.ResponseRequested = False
.Save 'Comment out if you do not want message saved to your
sent items folder
.Send
MsgBox "The event has been sent."
End With
End If
Set objOApp = Nothing
Set objAppt = Nothing
Set oExp = Nothing
Set oItems = Nothing
Set oFilter = Nothing
Exit_btnOutlook_Click:
Exit Sub
Err_btnOutlook_Click:
MsgBox Err.Description
Resume Exit_btnOutlook_Click
End Sub