Excel VBA создает собрание в календаре не по умолчанию - PullRequest
Новая
       17

Excel VBA создает собрание в календаре не по умолчанию

2 голосов
/ 05 апреля 2019

Как создать собрание в календаре не по умолчанию для адреса электронной почты не по умолчанию в outlook, используя код VBA?

Код, который у меня есть, создает приглашения в календаре по умолчанию для адреса электронной почты по умолчанию: 

Sub CreateAppointmentOutlook()

Dim oApp As Outlook.Application
Dim oApt As Outlook.AppointmentItem
Dim oRecip As Outlook.Recipient
Dim i As Long
Dim lastRow As Long
Dim ws As Worksheet
Dim wb As ThisWorkbook
Set oApp = New Outlook.Application

Set ws = ActiveWorkbook.Worksheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow
    Set oApt = oApp.CreateItem(olAppointmentItem)
    oApt.MeetingStatus = olMeeting
    Debug.Print (ws.Cells(i, 1).Value)
    With oApt
        .Subject = "Test"
        ' do some other stuff
    End With
Next i
End Sub

Самым близким, к которому я мог прийти, даже пытаясь изменить календарь, была эта ссылка . Чтобы даже начать пытаться реализовать этот код в моем примере, я сделал следующее в качестве теста 

Sub Whatever()
Dim olApp As Object
Set olApp = GetObject(, "Outlook.Application")
Dim ns As Outlook.Namespace

Set ns = olApp.GetNamespace("MAPI")
Dim Items As Object
Set Items = GetFolderPath("otheremail@contoso.com\Calendar").Items
Debug.Print (Items.Parent.FolderPath)
Debug.Print ("End")
End Sub

Но я получаю сообщение об ошибке «91»: переменная объекта или переменная блока не установлены в строке. Set Items = GetFolderPath ("otheremail@contoso.com \ Calendar"). Items

UPDATE

Этот код работает: 

Sub Whatever()
Dim olApp As Object
Set olApp = GetObject(, "Outlook.Application") 
Dim oApt As Outlook.AppointmentItem

Dim ns As Outlook.Namespace
Dim oFolder As Outlook.Folder

Set ns = olApp.GetNamespace("MAPI")
Set oFolder = ns.Folders("otheremail@contoso.com")

Dim CalItems As Outlook.Items
Set CalItems = oFolder.Items

End Sub

Но как тогда создать запись календаря в этой другой коллекции папок CalItems?

1 Ответ

0 голосов
/ 05 апреля 2019

Этот код создаст встречу в календаре не по умолчанию в учетной записи не по умолчанию в Outlook.Надеюсь, что это поможет кому-то еще в будущем: 

Sub Whatever()
Dim olApp As Object
Set olApp = GetObject(, "Outlook.Application")
Dim oApt As Outlook.AppointmentItem
Dim ns As Outlook.Namespace
Dim recip As Outlook.Recipient
Dim oFolder As Outlook.Folder
Set ns = olApp.GetNamespace("MAPI")
Set recip = ns.CreateRecipient("otheremail@contoso.com")

If recip.Resolve Then
    Set otherFolder = ns.GetSharedDefaultFolder(recip, olFolderCalendar)
End If

Set oApt = otherFolder.Items.Add(olAppointmentItem)

oApt.MeetingStatus = olMeeting
    With oApt
        .Subject = "Test"
        .Start = "15/04/2019 09:00"
        .End = "15/04/2019 09:10"
        .Location = "The Business Meeting Room"
        .Recipients.Add ("user@contoso.com")
        .Send
    End With
End Sub
...