Solved

VBA Code using Outlook and Redemption to send meetings, new a pointer

Posted on 2004-09-29
10
374 Views
Last Modified: 2008-02-01
The following is the code I'm using to create calendar appointments and meetings.
This is working with the local calendar, but the inventation for a meeting only makes it to the sent items folder, it never actually gets mailed out.  I can open outlook and forward the items in the sent items folder to the addressees and they go out just fine.  
Does any one have any pointers?

Public Function CreateAppointment(strSubject As String, strBody As String, dtStartTime As Date, dtEndTime As Date, bolAllDay As Boolean, Optional strAttendees As String)
On Error GoTo Errexit
Dim OlApp As New Outlook.Application, Appt As Object, safeAppt As Object
Set OlApp = CreateObject("Outlook.Application")
Set Appt = OlApp.Session.GetDefaultFolder(olFolderCalendar).Items
Set safeAppt = CreateObject("Redemption.SafeAppointmentItem")
Set Appt = OlApp.CreateItem(olAppointmentItem)
safeAppt.Item = Appt
With safeAppt
    .Subject = strSubject
    .Start = dtStartTime
    .End = dtEndTime
    .AllDayEvent = bolAllDay
    .Body = strBody
    If Len(strAttendees) > 0 Then
        .RequiredAttendees = strAttendees
        .MeetingStatus = olMeeting
    End If
    .Importance = olImportanceHigh
    .ReminderSet = True
    .ReminderMinutesBeforeStart = 30
    If Len(strAttendees) > 0 Then
        .Send
    Else
        .Save
    End If
End With
     Set Appt = Nothing
     Set safeAppt = Nothing
     Set OlApp = Nothing
Errexit:
    If Err <> 0 Then
        Debug.Print Err, Err.Description
        Stop
    End If
End Function
0
Comment
Question by:ajaac
  • 6
  • 4
10 Comments
 
LVL 15

Expert Comment

by:will_scarlet7
ID: 12180411
What bout creating and filling in your appointment item in the standard Outlook Appointment item then passing it to the SafeAppointmentItem to send. Like so:
'********************************
Public Function CreateAppointment(strSubject As String, strBody As String, dtStartTime As Date, dtEndTime As Date, bolAllDay As Boolean, Optional strAttendees As String)
On Error GoTo Errexit
Dim OlApp As New Outlook.Application, Appt As Object, safeAppt As Object
Set OlApp = CreateObject("Outlook.Application")
Set Appt = OlApp.Session.GetDefaultFolder(olFolderCalendar).Items
Set safeAppt = CreateObject("Redemption.SafeAppointmentItem")
Set Appt = OlApp.CreateItem(olAppointmentItem)
With Appt
    .Subject = strSubject
    .Start = dtStartTime
    .End = dtEndTime
    .AllDayEvent = bolAllDay
    .Body = strBody
    If Len(strAttendees) > 0 Then
        .RequiredAttendees = strAttendees
        .MeetingStatus = olMeeting
    End If
    .Importance = olImportanceHigh
    .ReminderSet = True
    .ReminderMinutesBeforeStart = 30
    .Save
End With

If Len(strAttendees) > 0 Then
    safeAppt.Item = Appt
    safeAppt.Item.Send
Else

     Set Appt = Nothing
     Set safeAppt = Nothing
     Set OlApp = Nothing

Errexit:
    If Err <> 0 Then
        Debug.Print Err, Err.Description
        Stop
    End If
End Function
'********************************

I'm not sure if it will fix teh problem, but it is wort a shot. (I've never had a time when a redemption item went to the sent items folder without actually sending)
Just so you know with most Outlook item properties you will not hit the security walls when writing to them, and I personally find them friendlier to work wit then the SafeItem properties, which I just use for sending.

God bless!
Sam
0
 

Author Comment

by:ajaac
ID: 12182990
I have tried using the send and receive button and nothing happens, I think Outlook thinks this has already been sent.  

This is part of an application that will be adding calendar items and meeting without user involvement, so I need it to work without the pop-ups.

I've tried this in an exchange environment and have the same problems.

I've seen several posts indicating the redemption is the way to go, so I must be doing something wrong, I just don't see the problem.
0
 
LVL 15

Expert Comment

by:will_scarlet7
ID: 12183160
What version of Outlook are you using?
0
 

Author Comment

by:ajaac
ID: 12183303
Outlook version is 2003 sr1
Access version is 2003 sr1, but I've also tried 2000 sr3
0
 

Author Comment

by:ajaac
ID: 12183415
scarlet7,

I tried your code, it brings up a security pop-up.
When you schedule the appt as a meeting it automatically sends the inventation and this will cause the security warning to pop-up.

I actually think this worked last week, but I'm not positive, and i have not idea what could have changed.

Still need a solution though.

0
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 
LVL 15

Expert Comment

by:will_scarlet7
ID: 12183795
I'll test it out more and see if I can suggest something tomorrow.
0
 
LVL 15

Accepted Solution

by:
will_scarlet7 earned 125 total points
ID: 12188453
Hi Ajaac,
I fiddled with it some and I think I got it to work. Try this:

Public Function CreateAppointment(strSubject As String, strBody As String, dtStartTime As Date, dtEndTime As Date, bolAllDay As Boolean, Optional strAttendees As String)
'On Error GoTo Errexit
Dim OlApp As New Outlook.Application, Appt As Object, safeAppt As Object
Set OlApp = CreateObject("Outlook.Application")
Set Appt = OlApp.Session.GetDefaultFolder(olFolderCalendar).Items
Set safeAppt = CreateObject("Redemption.SafeAppointmentItem")
Set Appt = OlApp.CreateItem(olAppointmentItem)
With Appt
    .Subject = strSubject
    .Start = dtStartTime
    .End = dtEndTime
    .AllDayEvent = bolAllDay
    .Body = strBody
    If Len(strAttendees) > 0 Then
        .RequiredAttendees = strAttendees
        .MeetingStatus = olMeeting
    End If
    .Importance = olImportanceHigh
    .ReminderSet = True
    .ReminderMinutesBeforeStart = 30
    .Save
End With

If Len(strAttendees) > 0 Then
    safeAppt.Item = Appt
    safeAppt.Recipients.Add (strAttendees)
    If safeAppt.Recipients.ResolveAll Then
        safeAppt.Send
    End If
End If

     Set Appt = Nothing
     Set safeAppt = Nothing
     Set OlApp = Nothing

Errexit:
    If Err <> 0 Then
        Debug.Print Err, Err.Description
        Stop
    End If
End Function
0
 
LVL 15

Expert Comment

by:will_scarlet7
ID: 12191352
I take that back. It works for me in some cases but not in others. It may work for you or not. Still fiddling...
0
 
LVL 15

Expert Comment

by:will_scarlet7
ID: 12412935
ThanX for the points Ajaac!
God bless!

Sam
0
 

Author Comment

by:ajaac
ID: 12413189
Sorry it took so long to get back to you.
I've been tied-up with other projects.
My code was missing the ResolveAll method and this seems to have fixed the problem.
Thanks again for you help
Allen
0

Featured Post

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

867 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now