Vba Excel在Outlook中创建任务

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

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

问题是当我放置=addtotasks（A1、A2、A3）时

它只是想出了一个名字

我已在引用中启用了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

“功能下一个工作日（日期从开始到结束日期）_
可选的DaysHead（长=1）为Date
将当前日期设置为日期
Dim nextDate As Date
'将neg转换为pos
如果daysAhead<0，则
daysAhead=Abs（daysAhead）
如果结束
“确定下一个日期
currentDate=dateFrom
nextDate=DateAdd（“d”，dayshead，currentDate）
“下次约会是周末吗？
选择案例工作日（下一天，vbUseSystemDayOfWeek）
星期日个案
nextDate=DateAdd（“d”，1，nextDate）
星期六的案件
nextDate=DateAdd（“d”，2，nextDate）
结束选择
NextBusinessDay=CDate（Int（nextDate））
端函数
Dim bWeStartedOutlook为布尔值
函数AddToTasks（strDate作为字符串，strText作为字符串，DaysOut作为整数）作为布尔值
'在指定日期之前的特定天数向Outlook任务添加任务提醒
“如果成功则返回TRUE”不会触发OMG，因为未访问任何受保护的属性
'
'用法：
“=AddToTasks（“12/31/2008”，“需要记住的东西”，30）
“或：
'=附加任务（A1、A2、A3）
'其中A1包含有效日期，A2包含任务信息，A3包含A1日期之前触发任务提醒的天数'
'也可在VBA中使用：
“如果AddTotask（“12/31/2008”，“圣诞购物”，30）那么
“MsgBox”好的
"完"
Dim intDaysBack为整数
标注日期
Dim olApp作为对象的Outlook.Application
将对象任务设置为对象的Outlook.TaskItem
'确保所有字段都已填写
如果在引用程序未知的函数或变量时发生（而不是IsDate（strDate））或（strText=“”）或（DaysOut错误，则不确定此函数的位置。请尝试使用公式栏旁边的“fx”按钮并选择用户定义的函数，应在此处列出

我猜您是在另一本工作手册中创建此函数的，可能是personal.xlsb

要使用用户定义的函数，必须引用它们的完整路径。请尝试阅读此处的最后一段：

BirdsView：您是否已将代码粘贴到模块中？是否尝试单步执行代码？不完全是…您的意思是“编译VBAProject”？它会在“If Dayshead<0 Then”上“卡住”-->编译错误：无效的外部过程-忽略此…仍在运行。不。您需要通过按F8OK单步调试代码-它直接跳到最后一个函数（getoutlookapp）-它甚至没有突出显示第一行好主意-是的，我有：=PERSONAL.XLSB！AddToTasks（A1、A2、A3）我现在有以下错误：编译错误：ByRef参数类型不匹配它在以下行突出显示“intDaysBack”：dteDate=NextBusinessDay（CDate（strDate），intDaysBack）尝试将“ByVal”添加到下一个工作日函数日，如下所示：函数NextBusinessDay（dateFrom As Date，u可选ByVal DaysHead As Long=1）As DateYES！它成功了-谢谢你。我不得不将Dim bWeStartedOutlook作为布尔值移动到其他“Dim”旁边。np，很高兴我能帮上忙