1

我想使用 Excel VBA 在 Outlook 中设置任务提醒，所以我从这里找到了这段代码： http ://www.jpsoftwaretech.com/using-excel-vba-to-set-up-task-reminders-in-外表/

Dim bWeStartedOutlook As Boolean

Function AddToTasks(strDate As String, strText As String, DaysOut As Integer) As Boolean
=AddToTasks(B2, M2 Time, 120)



' 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
' by Jimmy Pena, http://www.jpsoftwaretech.com, 10/30/2008
'
' 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
Sub Test()

我的问题是，如果我有电子表格中的所有数据，并且我像这样初始化 AddToTasks： =AddToTasks(A1, A2, 120)

为什么会出现这个错误？

4

1 回答 1

1

您需要AddToTasks从单独的Subroutine. （现在你正试图从内部调用它。）所以，创建一个单独的Subroutine类似这样的东西：

Sub CallAddToTasksFunction

If AddToTasks("12/31/2008", "Something to remember", 30) = True Then
   Debug.Print "Task Added"
Else
   Debug.Print "Failed"
End If
End Sub

AddToTasks返回True或False取决于它是否成功。您可以在函数中的几个位置看到发生这种情况的代码如下：

AddToTasks = False (or True)

你可以看到日期之类的东西不是真正的日期会导致它失败。

于 2013-06-16T21:26:20.070 回答