自动创建Outlook约会

Question

我有一个跟踪到期日期的电子表格（excel 2003），我想知道是否有办法让这些到期日期在outlook中创建约会（提醒）。 到期日期在一个字段中，实体的名称在电子表格的另一列中。 理想情况下，我希望outlook（2003）获取日期（显然）和实体的名称。

在此先感谢您的帮助

Answer 1

您可以使用VBA宏创建外观约会。 以下2个链接将帮助您入门。

1. 使用VBA创建Outlook预约
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

您可以通过会议邀请来完成此操作。 他们不会被自动接受，但他们会在那里。 会议邀请只是标题中包含特殊内容的电子邮件。