How to Add An Appointment In Another Calendar Folder Through Access VBA RRS feed

  • Question

  • I'm designing the code below so I can automatically send appointments invitations through my Access file to Outlook Calendar.

    The problem is that I don't want to fill my default email account with tons of appointments. I would rather choose another personal calendar or shared calendar and send the appointment through that ones.

    In the code below I try to send using another email account "viagens@company.com" but the Appointment is always added to my default account.

    I think I spent more than 5 hours around this but could not figure a solution out. Please HELP!

    Private Sub Command10_Click()

    Dim obj0App As Object
    Dim objAppt As Object
    Dim EmailAddy As Object
    Dim ASMail As Object
    Dim QualificationEmail As Object
    Dim STdate As Object
    Dim StTime As Object
    Dim Edate As Object
    Dim Location As Object
    Dim test As Object

    Set obj0App = CreateObject("outlook.Application")
    Set objAppt = obj0App.CreateItem(1) 'olAppointmentItem
    With objAppt

    .SendUsingAccount = "viagens@company.com"
    .RequiredAttendees = "test@company.com; francisco@company.com"
    '.OptionalAttendees = Forms("Copy Of frm_task").ASMail.Value
    .Subject = "Training booked for " & " " & Forms("Copy Of frm_task").Contato.Value
    .Importance = 2 'high
    .Start = Forms("Copy Of frm_task").ETS.Value
    .End = Forms("Copy Of frm_task").ETA.Value
    .Location = "Multilem"
    .ReminderMinutesBeforeStart = 60 'reminder set for two weeks before     the event
    '.Body = "Training for" & " " & Forms("Copy Of frm_task").QualificationEmail.Value & "." & vbNewLine & "Any changes to this arrangement will be emailed to you.     You will recieve any confirmation for bookings nearer the time."
    .MeetingStatus = 1
    .ResponseRequested = False
    MsgBox "Appointment sent"
    End With

    End Sub

    Friday, May 10, 2019 4:06 PM