Автоматически создавать встречи Outlook

Question

У меня есть электронная таблица (Excel 2003), в которой отслеживаются даты истечения срока действия. Я хотел бы знать, существует ли способ, чтобы эти даты истечения срока действия создавали встречи (напоминания) в Outlook. Дата истечения срока действия находится в одном поле, а имя объекта - в другом столбце электронной таблицы. В идеале я хотел бы, чтобы outlook (2003) выбрал дату (очевидно) и название организации.

Заранее спасибо за любую помощь

Answer 1

Вы можете использовать макросы VBA для создания внешних встреч. Следующие 2 ссылки помогут вам начать работу.

1. Создание встречи Outlook с использованием VBA
2. Outlookcode

Answer 2

Вот пример кода.

Sub CreateCalEntry(LeadDate As Date, DueDate As Date, _
            Subject As String, Location As String, _
            Body As String, _
            Optional AddToShared As Boolean = True)

'Lead date = expect notify from data'
'Due date - expect event due date'
'Add to shared - add item to shared calendar, '
'hard coded as 'Shared Calendar''

Const olApItem = 1

Dim apOL As Object 'Outlook.Application '
Dim oItem As Object 'Outlook.AppointmentItem '
Dim objFolder As Object 'MAPI Folder '

    Set apOL = CreateObject("Outlook.Application")
    Set objFolder = GetFolder( _
         "Public Folders/All Public Folders/Shared Calender")
    Set oItem = apOL.CreateItem(olApItem)

    With oItem
        .Subject = Subject
        .Location = Location
        .Body = Body

        If IsDate(LeadDate) Then
            .Start = DueDate
        Else
            .Start = DueDate
        End If

        If AddToShared = True Then
            .Move objFolder
        End If

        .Display
    End With

    Set oItem = Nothing
    Set apOL = Nothing

End Sub

Public Function GetFolder(strFolderPath As String) As Object 
' strFolderPath needs to be something like '
'   "Public Folders\All Public Folders\Company\Sales" or '
'   "Personal Folders\Inbox\My Folder" '
'This code is from: 
'http://www.outlookcode.com/d/code/getfolder.htm '

Dim apOL As Object 'Outlook.Application '
Dim objNS As Object 'Outlook.NameSpace '
Dim colFolders As Object 'Outlook.Folders '
Dim objFolder As Object 'Outlook.MAPIFolder '
Dim arrFolders() As String 
Dim I As Long

    strFolderPath = Replace(strFolderPath, "/", "\")
    arrFolders() = Split(strFolderPath, "\")

    Set apOL = CreateObject("Outlook.Application")
    Set objNS = apOL.GetNamespace("MAPI")

    On Error Resume Next

    Set objFolder = objNS.Folders.Item(arrFolders(0))

    If Not objFolder Is Nothing Then
        For I = 1 To UBound(arrFolders)
            Set colFolders = objFolder.Folders
            Set objFolder = Nothing
            Set objFolder = colFolders.Item(arrFolders(I))

            If objFolder Is Nothing Then
                Exit For
            End If
        Next
    End If

    Set GetFolder = objFolder
    Set colFolders = Nothing
    Set objNS = Nothing
    Set apOL = Nothing

End Function

От: http://wiki.lessthandot.com/index.php/Create_Outlook_Appointment%2C_Shared_Folder

Answer 3

Вы можете сделать это с помощью приглашения на встречу. Они не будут автоматически приняты, но они будут там. Приглашения на собрание - это просто электронные письма со специальным содержимым в заголовках.