outlook - 如何将Outlook代码更改为后期绑定
问题描述
我尽力将代码更改为后期绑定,但完全搞砸了。我是初学者,所以我问你。有人可以帮忙吗?我需要它,因为代码在具有不同办公版本的不同站点之间运行......你能帮忙吗?谢谢
'-------------------------------------------------
'original code early binding (yes, inspired from web forums):
'-------------------------------------------------
Sub CreateAppointment()
' adds a appontments to non deafault folder the Calendar in Outlook
Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim olFldr As Outlook.MAPIfolder 'not needed in only default folder is used
Dim objOwner As Outlook.recipient 'not needed in only default folder is used
Dim oNs As Namespace 'not needed in only default folder is used
Dim oPattern As RecurrencePattern
On Error Resume Next
Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook nie je nainštalovaný"
Exit Sub
End If
End If
' Allow accessing data stored in the user's mail stores in Outlook (not needed for default folder)
Set oNs = Outlook.GetNamespace("MAPI")
' Set share calender owner (not needed for default folder)
Set objOwner = oNs.CreateRecipient("jhajko@...")
objOwner.Resolve
On Error Resume Next
If objOwner.Resolved Then ' (not needed if default folder is used)
' Set up non-default share folder location
Set olFldr = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar).Parent.Folders("Narodeniny")
' Set up non-default folder location
Set olFldr = oNs.GetDefaultFolder(olFolderCalendar).Parent.Folders("Narodeniny")
End If
On Error GoTo errorhandler:
'Set olAppItem = olApp.CreateItem(olAppointmentItem) ' creates a new appointment in default folder
Set olAppItem = olFldr.Items.Add ' creates a new appointment in non default folder
'ročné opakovanie
Set oPattern = olAppItem.GetRecurrencePattern
With oPattern
' Appointment occurs every n-th year (with n indicated by the Interval property)
.RecurrenceType = olRecursYearly
' Appointment becomes effective on...
.DayOfMonth = Format(myStartDate, "d")
.MonthOfYear = Format(myStartDate, "m")
' Appointment starts at ...
.StartTime = myStartTime
' Appointment ends at...
.EndTime = myEndTime
End With
With olAppItem
' set default appointment values
.Location = myLocation
.Body = myBody
.ReminderSet = True
.ReminderMinutesBeforeStart = myReminder
.BusyStatus = myBusyStatus
.RequiredAttendees = myRecipient
On Error Resume Next
.Start = myStartTime & myStartDate
.End = myEndTime & myEndDate
.Subject = mySubject
'.Attachments.Add ("c:\temp\somefile.msg")
.Categories = myCategory ' add this to be able to delete the testappointments
On Error GoTo 0
.Display
.Save 'saves the new appointment
'.Send 'pošle pozvánku
End With
'Release references to the appointment series
Set oPattern = Nothing
Set olAppItem = Nothing
Set olApp = Nothing
End
errorhandler:
MsgBox ("Error: " & Err.Description)
End Sub
'-------------------------------------------------
'my not working trial for late binding:
'-------------------------------------------------
Sub CreateAppointmentLateBinding()
' adds a appontments to non deafault folder the Calendar in Outlook
Const olFolderCalendar As Long = 9
Const olAppointmentItem As Long = 1
Const olBusy As Long = 2
Dim olApp As Object
Dim olAppItem As Object
Dim olFldr As Object
Dim objOwner As Object 'not needed in only default folder is used
Dim oNs As Object 'not needed in only default folder is used
Dim oPattern As Object
Set olApp = CreateObject("Outlook.Application")
Set olAppItem = olApp.AppointmentItem
Set olFldr = olApp.MAPIfolder 'not needed in only default folder is used
Set objOwner = olApp.recipient
Set oNs = olApp.Namespace 'not needed in only default folder is used
Set oPattern = olApp.RecurrencePattern
On Error Resume Next
Set olApp = GetObject(Class:="Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook nie je nainštalovaný"
Exit Sub
End If
End If
' Allow accessing data stored in the user's mail stores in Outlook (not needed for default folder)
Set oNs = olApp.GetNamespace("MAPI")
' Set share calender owner (not needed for default folder)
Set objOwner = oNs.CreateRecipient("jhajko...")
objOwner.Resolve
On Error Resume Next
If objOwner.Resolved Then ' (not needed if default folder is used)
' Set up non-default share folder location
Set olFldr = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar).Parent.Folders("Narodeniny")
' Set up non-default folder location
Set olFldr = oNs.GetDefaultFolder(olFolderCalendar).Parent.Folders("Narodeniny")
End If
On Error GoTo errorhandler:
'Set olAppItem = olApp.CreateItem(olAppointmentItem) ' creates a new appointment in default folder
Set olAppItem = olFldr.Items.Add(allAppItem) ' creates a new appointment in non default folder
'ročné opakovanie
Set oPattern = olAppItem.GetRecurrencePattern
With oPattern
' Appointment occurs every n-th year (with n indicated by the Interval property)
.RecurrenceType = olRecursYearly
' Appointment becomes effective on...
.DayOfMonth = Format(myStartDate, "d")
.MonthOfYear = Format(myStartDate, "m")
' Appointment starts at ...
.StartTime = myStartTime
' Appointment ends at...
.EndTime = myEndTime
End With
With olAppItem
' set default appointment values
.Location = myLocation
.Body = myBody
.ReminderSet = True
.ReminderMinutesBeforeStart = myReminder
.BusyStatus = myBusyStatus
.RequiredAttendees = myRecipient
On Error Resume Next
.Start = myStartTime & myStartDate
.End = myEndTime & myEndDate
.Subject = mySubject
'.Attachments.Add ("c:\temp\somefile.msg")
.Categories = myCategory ' add this to be able to delete the testappointments
On Error GoTo 0
.Display
.Save 'saves the new appointment
'.Send 'pošle pozvánku
End With
'Release references to the appointment series
Set oPattern = Nothing
Set olAppItem = Nothing
Set olApp = Nothing
End
errorhandler:
MsgBox ("Error: " & Err.Description)
End Sub
解决方案
要使用后期绑定,您应该将所有 Outlook 特定对象声明为Object
:
Dim olApp As Object, olNamespace As Object, olFolder As Object, olConItems As Object
然后:
Set olApp = CreateObject("Outlook.Application")
这将使每台计算机从安装在其上的 Outlook 库创建 olApp 对象。
欲了解更多信息,请参阅以下链接:
推荐阅读
- python - 无法构建张量流 C++ windows 10,找不到 numpy
- c# - 如何使用流利的 nhibernate 在 Visual Studio 控制台中显示 SQL?
- android - 无法在房间数据库中保存经度
- php - prepare() 输出 bool false,语句对我来说是正确的
- latex - 与论文标题的句子对齐(LaTex)
- python - pandas 将 multiindex 重新索引到更高频率的日期
- raspberry-pi3 - 如果 ATtiny25 上的 0x200 之后的主函数地址,Avr C 代码不起作用
- python - dataframe.resample('4T').mean() 产生不正确的第一个结果,但后续结果是一致的
- mysql - 如何打印一个 MySQL 表来计算每个前三个驱动程序的驱动器数量?
- java - JPA CriteriaBuilder 方法:键和值。如何使用它们?