【发布时间】：2019-03-15 04:20:07
【问题描述】：
我知道声明中还有其他内容，用于我编写的其他宏。
我有几个日历。我有一个电子表格，我可以在其中粘贴有关网站的信息，并且我有生成约会和电子邮件的按钮。
我有设置约会的代码，但它会转到我的主日历。我正在尝试将约会记录到我的其他日历上。我已经阅读了有关 MAPI 函数的信息，但无法使其正常工作。位置是 \myemail@me.com\Calendar。日历的名称是 SVN Calendar。
Dim olApp As Outlook.Application9
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.
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()
'trial run of SVN Calendar with other code
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- 我必须手动邀请与会者，这违背了邀请的目的。
【问题讨论】：
-
一旦你引用文件夹切换到 .Add 而不是 Create
-
谢谢，蒂姆。我之前实际上看过那个链接。我不断收到“对象不支持此属性或方法”的错误。我会继续尝试，也许我没有在正确的地方......
-
niton - 我想看看 .add 会去哪里。我在那里看不到创建功能...
标签： excel vba outlook appointment