Excel在Outlook中创建任务

时间:2014-03-28 12:18:03

标签: excel vba excel-vba outlook

我对VBA比较陌生,所以我确定这是我犯的一个基本错误!

A1包含有效日期,A2包含任务信息,A3包含A1日期之前触发任务提醒的天数。

问题是我把= addtotasks(A1,A2,A3)

它只是#NAME?

我在参考资料中启用了Microsoft Outlook 14.0对象库。

我常驻英国,告诉你日期。

这是以下代码。我已经包含了一些额外的代码,用于仅在工作日设置剩余部分。

'Function NextBusinessDay(dateFrom As Date, _
  Optional daysAhead As Long = 1) As Date
 Dim currentDate As Date
 Dim nextDate As Date

' convert neg to pos
 If daysAhead < 0 Then
  daysAhead = Abs(daysAhead)
End If

' determine next date
 currentDate = dateFrom
 nextDate = DateAdd("d", daysAhead, currentDate)

 ' is next date a weekend day?
  Select Case Weekday(nextDate, vbUseSystemDayOfWeek)
Case vbSunday
nextDate = DateAdd("d", 1, nextDate)
 Case vbSaturday
 nextDate = DateAdd("d", 2, nextDate)
  End Select

  NextBusinessDay = CDate(Int(nextDate))


End Function

Dim bWeStartedOutlook As Boolean

Function AddToTasks(strDate As String, strText As String, DaysOut As Integer) As Boolean
' Adds a task reminder to Outlook Tasks a specific number of days before the date specified
' Returns TRUE if successful ' Will not trigger OMG because no protected properties are accessed
'
' Usage:
' =AddToTasks("12/31/2008", "Something to remember", 30)
' or:
' =AddToTasks(A1, A2, A3)
' where A1 contains valid date, A2 contains task information, A3 contains number of days before A1 date to trigger task reminder '
' can also be used in VBA :
'If AddToTasks("12/31/2008", "Christmas shopping", 30) Then
'  MsgBox "ok!"
'End If
Dim intDaysBack As Integer
Dim dteDate As Date
Dim olApp As Object 'Outlook.Application
Dim objTask As Object ' Outlook.TaskItem
' make sure all fields were filled in
If (Not IsDate(strDate)) Or (strText = "") Or (DaysOut <= 0) Then
AddToTasks = False
GoTo ExitProc
End If
' We want the task reminder a certain number of days BEFORE the due date
' ex: if DaysOut = 120, then we want the due date to be -120 before the date specified
' we need to pass -120 to the NextBusinessDay function, so to go from 120 to -120,
' we subtract double the number (240) from the number provided (120).
' 120 - (120 * 2); 120 - 240 = -120
intDaysBack = DaysOut - (DaysOut * 2)

dteDate = NextBusinessDay(CDate(strDate), intDaysBack)

On Error Resume Next
   Set olApp = GetOutlookApp
On Error GoTo 0

If Not olApp Is Nothing Then
   Set objTask = olApp.CreateItem(3)   ' task item

   With objTask
    .StartDate = dteDate
    .Subject = strText & ", due on: " & strDate
    .ReminderSet = True
    .Save
   End With

Else
   AddToTasks = False
   GoTo ExitProc
End If

   ' if we got this far, it must have worked
AddToTasks = True

ExitProc:
If bWeStartedOutlook Then
   olApp.Quit
End If
Set olApp = Nothing
Set objTask = Nothing
End Function

Function GetOutlookApp() As Object

On Error Resume Next
   Set GetOutlookApp = GetObject(, "Outlook.Application")
   If Err.Number <> 0 Then
    Set GetOutlookApp = CreateObject("Outlook.Application")
    bWeStartedOutlook = True
   End If
On Error GoTo 0

End Function

顺便提一下,我从这个网站上获取了这段代码: http://www.jpsoftwaretech.com/get-previous-business-day-in-vba/

1 个答案:

答案 0 :(得分:0)

#Name?当您引用程序未知的函数或变量时,会发生错误。它不确定此功能所在的位置。尝试使用&#34; fx&#34;按下公式栏旁边的按钮并选择用户定义的函数,它应该在那里列出。

我的猜测是你在另一本工作书中创建了这个函数,可能是personal.xlsb。

要使用用户定义的函数,您必须引用它们的完整路径。试着阅读最后一段:

http://office.microsoft.com/en-us/excel-help/creating-custom-functions-HA001111701.aspx