我有一个跟踪到期日期的电子表格(excel 2003),我想知道是否有办法让这些截止日期在outlook中创建约会(提醒)。到期日期在一个字段中,实体的名称位于电子表格的另一列中。理想情况下,我希望展望(2003年)拿起日期(显然)和实体的名称。自动创建Outlook约会
预先感谢任何帮助
我有一个跟踪到期日期的电子表格(excel 2003),我想知道是否有办法让这些截止日期在outlook中创建约会(提醒)。到期日期在一个字段中,实体的名称位于电子表格的另一列中。理想情况下,我希望展望(2003年)拿起日期(显然)和实体的名称。自动创建Outlook约会
预先感谢任何帮助
您可以使用VBA宏来创建出来的样子约会。 以下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
感谢您的建议,我已经从项目拉动的时刻,所以我还没有机会检查什么工作与什么犯规!只要我愿意,我会尽快。 – 2009-03-10 19:31:21