Excel VBA Outlook Назначение в календарь не по умолчанию - PullRequest
Новая
       36

Excel VBA Outlook Назначение в календарь не по умолчанию

1 голос
/ 15 марта 2019

хорошо, так что я могу быть обжором здесь для наказания и пыток. очень плохо знаком с VBA в Excel, так что будьте добры, лол Я работаю в сфере здравоохранения, а работа с кодом - это то, с чем я начал коллегу, работая в электронных таблицах. просто делаю гугл и YouTube видео, учу себя, что делает что. извиняюсь за чудовище, которое ниже. я знаю, что в объявлениях есть дополнительные вещи, они написаны для других макросов.

в Outlook, у меня есть несколько календарей, на которые я планирую разные вещи. Я создал электронную таблицу, куда я вставляю информацию о сайте, и у меня есть макрокнопки, которые генерируют встречи и электронные письма для меня. У меня есть код, в котором будет назначена встреча, однако все это идет в мой основной календарь. Я пытаюсь записаться на прием в другие мои календари. Я читал о функциях MAPI, но я не могу заставить его работать. расположение по адресу \ myemail@me.com \ Calendar, если это поможет. Название календаря SVN Calendar. Я работал над этим пару недель и продолжаю рисовать бланк. любая помощь очень ценится. 

Dim olApp As Outlook.Application
Dim olEmail As Outlook.MailItem
Dim olCal As Outlook.AppointmentItem
Dim olFolder As Outlook.Folder
Dim RequiredAttendee, OptionalAttendee, ResourceAttendee As Outlook.Recipient
Dim rtf() As Byte

Dim rngTo As Range
Dim rngCC As Range
Dim rngSUB As Range
Dim rngCALloc As Range
Dim rngCALstart As Range
Dim rngCALend As Range
Dim rngBody As Range
Dim myItem As Object

Sub newTestCreateCalendarUSA1()
'Testing calendar to other calendar than main.  i.e. SVN Calendar.  can't identify the actual calendar.  damnit.'

Set olApp = New Outlook.Application
Set m = olApp.CreateItem(olMailItem)
Set appt = olApp.CreateItem(olAppointmentItem)

With ActiveSheet
    Set rngCC = .Range("I34")
    Set rngCALloc = .Range("I5")
    Set rngCALstart = .Range("I11")
    Set rngCALend = .Range("I12")
    Set rngSUB = .Range("I33")
    Set rngSite = .Range("C2")
    Set rngLoc = .Range("C4")
    Set rngTYPE = .Range("B23")
    Set rngGON = .Range("C23")
    Set rngPurpose = .Range("C21")
    Set rngGoals = .Range("C22")
    Set rngDate = .Range("I1")
    Set rngDateStart = .Range("I8")
    Set rngDateEnd = .Range("I9")
    Set rngTime = .Range("I10")
    Set rngCAS = .Range("C26")

End With

MsgBox "Ensure all attendees are correct prior to sending invite."

    appt.MeetingStatus = olMeeting
    appt.RequiredAttendees = rngCC.Value
    appt.Subject = rngSUB.Value
    appt.Location = rngCALloc.Value
    appt.Start = rngCALstart.Value
    appt.End = rngCALend.Value
    appt.AllDayEvent = True
    m.BodyFormat = olFormatHTML
    m.HTMLBody = Range("I31").Value
    m.GetInspector().WordEditor.Range.FormattedText.Copy
    appt.GetInspector().WordEditor.Range.FormattedText.Paste
    appt.Display
    m.Close False

End Sub

Редактировать: спасибо за указание следить за деревом папок, Нитон. Я пытался понять всю вещь GetNameSpace, но просто не мог заставить его работать. это то, что я получаю за то, что я не программист, я думаю ...

я нашел другой код для вставки, и он назначил мне встречу в правильном календаре. Sub SVN_Calendar_Invite () пробный запуск Календаря SVN с другим кодом Dim oApp As Object Dim oNameSpace As Namespace Dim oFolder As Object 

Set oApp = New Outlook.Application
Set oNameSpace = oApp.GetNamespace("MAPI")
Set oFolder = oNameSpace.GetFolderFromID("0000000098F32312526B334EAEC97D94705E33FB0100C964D8D325E3554DA24A72FB876E3F600001912394000000")

With ActiveSheet
Set rngCC = .Range("I34")
Set rngCALloc = .Range("I5")
Set rngCALstart = .Range("I11")
Set rngCALend = .Range("I12")
Set rngSUB = .Range("I33")
Set rngSite = .Range("C2")
Set rngLoc = .Range("C4")
Set rngTYPE = .Range("B23")
Set rngGON = .Range("C23")
Set rngPurpose = .Range("C21")
Set rngGoals = .Range("C22")
Set rngDate = .Range("I1")
Set rngDateStart = .Range("I8")
Set rngDateEnd = .Range("I9")
Set rngTime = .Range("I10")
Set rngCAS = .Range("C26")

End With

With oFolder

Set olApt = oApp.CreateItem(olAppointmentItem)
With olApt
            .AllDayEvent = True
            .RequiredAttendees = rngCC.Value
            .Start = rngDateStart.Value
            .End = rngDateEnd.Value
            .Subject = rngSUB.Value
            .Location = rngLoc.Value
            .Body = "The body of your appointment note"
            .BusyStatus = olFree
            .Save
            .Move oFolder

 End With
    Set olNS = Nothing
    Set olApp = Nothing
    Set olApt = Nothing


End With

End Sub

У меня сейчас пара проблем. 1 - если я использую .Display, чтобы вызвать элемент календаря, чтобы просмотреть его, он не отображается вообще. 2 - несмотря на то, что это событие на весь день, и ячейки разделены на 3 дня, вычитается конечная дата на 1 день. 3- Я должен пригласить участников вручную, что лишает их цели.

...