Question

我尽力将代码更改为后期绑定，但完全搞砸了。我是个初学者，所以我问你。有人可以帮忙吗？我需要它，因为代码在具有不同办公版本的不同工作站之间运行... 你能帮我吗？谢谢

'-------------------------------------------------
'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

Answer 1

要使用后期绑定，应将所有特定于Outlook的对象声明为Object：

Dim olApp As Object, olNamespace As Object, olFolder As Object, olConItems As Object

然后：

Set olApp = CreateObject("Outlook.Application")

这将使每台计算机从安装在其上的Outlook库中创建olApp对象。

有关更多信息，请参考以下链接：

Convert Early Binding VBA to Late Binding VBA : Excel to Outlook Contacts

如何将Outlook代码更改为后期绑定

1 个答案: