首页 文章

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

提问于
浏览 次
0

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

这些事件将是 all-day 个事件。我希望将当前行的日期添加到日历中。这三个日期都将在电子表格的同一行中。

代码创建约会，但是 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
excel vba outlook calendar

2 回答

  • 0

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

    回复于
  • 0

    Dmitry 指出了如何在 Excel 的共享日历中创建 appointment/meeting 的功能。他的帖子对我有很大帮助，因为在共享日历上如何创建约会似乎没有很好的答案。我遍历众多论坛以获取答案，但提出的建议很少。根据他的回答，我能够使其工作。以下是我放在一起的示例脚本。这是我所用的 stripped-down 版本，但是我确实测试了此示例，并且可以正常工作。只需确保在 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
    回复于

相关问题