如何将 outlook 代码更改为后期绑定
how to change outlook code to late binding
我尽力将代码更改为后期绑定，但完全搞砸了。我是初学者，所以我问你。有人可以帮忙吗？我需要它，因为代码在具有不同办公版本的不同站点之间运行...
你能帮我吗 ？谢谢
'-------------------------------------------------
'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 对象。
更多内容请参考下方link:
我尽力将代码更改为后期绑定，但完全搞砸了。我是初学者，所以我问你。有人可以帮忙吗？我需要它，因为代码在具有不同办公版本的不同站点之间运行... 你能帮我吗 ？谢谢
'-------------------------------------------------
'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 对象。
更多内容请参考下方link: