Question

我正在尝试在特定（共享）日历中创建三个Outlook约会。

活动将是全天活动。我希望将当前行的日期添加到日历中。所有三个日期都将位于电子表格的同一行。

代码创建约会但for循环不起作用。创建的唯一事件是最后一个日期。

Sub Makeapt()
Set myOutlook = CreateObject("Outlook.Application")

Set myApt = myOutlook.createitem(1)
Dim i As Integer    
For i = 3 To 5
    myApt.Subject = Cells(ActiveCell.Row, 1).Value
    myApt.Start = Cells(ActiveCell.Row, i).Value
    myApt.Save
Next i

End Sub

我解决了这个问题。 Appt仍然会进入默认日历，但这实际上更可取。

Sub Makeapt()

Dim warning
warning = MsgBox("You are about to create Outlook appointments for subject #" & Cells(ActiveCell.Row, 3) & ". Is that right?", vbOKCancel)
If warning = vbCancel Then Exit Sub

Set myOutlook = CreateObject("Outlook.Application")
Set ID = Cells(ActiveCell.Row, 3)
Dim i As Integer

For i = 7 To 9
    Set myApt = myOutlook.createitem(1)
    myApt.Subject = "Subject #" & ID
    myApt.Start = Cells(ActiveCell.Row, i).Value
    myApt.Save
Next i

End Sub

Answer 1

如果您想要共享日历，请使用Application.CreateRecipient创建收件人对象，使用Application.Session.GetSharedDefaultFolder打开共享日历，使用MAPIFolder.Items.Add创建约会。

Answer 2

Dmitry指出了如何在Excel中的共享日历中创建约会/会议的方法。他的帖子对我有很大帮助，因为在共享日历上如何创建约会似乎没有很好的答案。我遍历众多论坛以获取答案，但提出的建议很少。根据他的回答，我能够使其工作。以下是我放在一起的示例脚本。这是我所使用的东西的精简版本，但是我确实测试了此示例，并且可以正常工作。只需确保在Excel VBA编辑器的“工具”->“参考”菜单项中选择了Outlook库。

Sub SendInvitationAsUser()

Rcpts = "user@test.com; user2@test.com, etc@test.com" ' These can be in other formats that Outlook understands like display name.
Subject = "Meeting sent from shared calendar"

' Creates Outlook instance
Set OutApp = CreateObject("Outlook.Application")

Dim myNamespace As Outlook.Namespace
Dim myRecipient As Outlook.Recipient
Dim objfolder As Outlook.Folder

Set myNamespace = OutApp.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Smith, John Q") 'The invite will come from this user's mailbox
myRecipient.Resolve
If myRecipient.Resolved Then
   Set objfolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar) 'Sets folder where appt will be created
Else
    ok = MsgBox("Unable to resolve the name of the sender.", vbCritical, "Error")
    Exit Sub
End If

Set OutlookAppt = objfolder.Items.Add(olAppointmentItem) 'Creates appointment in shared calendar

' Edit Outlook appointment, convert to meeting invitation by adding recipients.
With OutlookAppt
    .MeetingStatus = olMeeting
    .Subject = Subject
    .Start = #1/1/2018 8:00:00 AM#
    .End = #1/1/2018 9:00:00 AM#
    .Location = "Conference Room 1"
    .RequiredAttendees = Rcpts
End With

'Use Word to do fancy formatting of body text. Example below is basic but a lot of formatting via VBA is possible.
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Add
Set DocSelection = WordApp.Selection

WordApp.Visible = True 
WordDoc.Activate ' You want to see the window, right?

DocSelection.Font.Name = "Arial" ' Everything is Arial.
DocSelection.Font.Size = "10" ' Everything is size 10.
DocSelection.ParagraphFormat.SpaceAfter = "0" ' No line spacing.
DocSelection.ParagraphFormat.SpaceBefore = "0" ' No line spacing.

DocSelection.TypeText ("Please plan to attend my meeting.")

WordDoc.Content.Copy
OutlookAppt.Display
Set TargetApptDoc = OutlookAppt.GetInspector.WordEditor
TargetApptDoc.Range(0, 0).Paste

WordDoc.Close savechanges:=False
WordApp.Quit

End Sub

从Excel在特定日历中创建Outlook约会

2 个答案: