为什么我的VBA脚本在Outlook中寻找一个子文件夹是随机的,然后有时候不会呢?

我在Excel VBA中有一个脚本,用于在工作中的共享收件箱中的子文件夹中查找特定的电子邮件。 团队中的每个人都有自己的个人收件箱,然后我们都可以访问为团队提供的单个收件箱。 我有参考文献中检查Outlook库。 大部分时间在我的电脑上工作。 当我的同事试图运行脚本时,它有时会起作用,但通常不会运行。 然后每当我在我的机器上运行它,它将工作,然后在我的同事的机器上完美地运行。

当脚本尝试将“userf”variables设置为Outlook.MAPIfolder对象时,它失败。 子文件夹存在于我们所有机器上的共享收件箱中,所以我不确定它为什么随机起作用,有时却不起作用。

我把脚注放在脚本崩溃的代码底部。

这里是代码:

 Dim olNs As Outlook.Namespace Dim f As Outlook.MAPIFolder, subf As Outlook.MAPIFolder, userf As Outlook.MAPIFolder Dim currentitem As Object Dim currentatt As Outlook.Attachment Dim firstDayNo As Variant, monthNo As Variant Dim wbMonth As String, attachmentname As String, fpath As String, rngName As String, datestring As String Dim five9 As Outlook.Items, five9rng As Outlook.Items Dim wbCopy As Workbook, wbPaste As Workbook Dim ReadyDone As Boolean, CallsDone As Boolean, ACWDone As Boolean, LoginDone As Boolean, NotReadyDone As Boolean, monthReal As Boolean, dayReal As Boolean Dim newdate As Date Dim daysInMonthSelected As Long monthReal = False Do Until monthReal monthNo = InputBox("Enter the month number you wish to create the Agent Reason Code Summary for.") If monthNo = vbNullString Then ThisWorkbook.Close savechanges:=False ElseIf (monthNo < 1 Or monthNo > 12) Then MsgBox "Input must be a numeric value between 1 and 12. Try again." Else monthReal = True End If Loop ReadyDone = False CallsDone = False ACWDone = False LoginDone = False NotReadyDone = False Select Case monthNo Case 1 wbMonth = "Jan" Case 2 wbMonth = "Feb" Case 3 wbMonth = "Mar" Case 4 wbMonth = "Apr" Case 5 wbMonth = "May" Case 6 wbMonth = "Jun" Case 7 wbMonth = "Jul" Case 8 wbMonth = "Aug" Case 9 wbMonth = "Sep" Case 10 wbMonth = "Oct" Case 11 wbMonth = "Nov" Case 12 wbMonth = "Dec" End Select strMnth = CStr(monthNo) yr = Year(Date) ActiveWorkbook.SaveAs "\\hrn-prod-nas2\enrollment_operations\WFM\Agent Reason Code\" & yr & "\" & monthNo & " " & wbMonth & "_Agent Reason Code Summary.xlsm", FileFormat:=52 If strMnth = "" Then ThisWorkbook.Close Else dayReal = False Do Until dayReal firstDayNo = InputBox("Enter the first day number.") daysInMonthSelected = MonthDays(monthNo) If firstDayNo = vbNullString Then ThisWorkbook.Close savechanges:=False ElseIf (firstDayNo < 1 Or firstDayNo > daysInMonthSelected) Then MsgBox "Input must be a numeric value between 1 and " & daysInMonthSelected & ". Try again." Else datestring = monthNo & "/" & firstDayNo & "/" & Year(Date) newdate = CDate(datestring) If newdate >= Date Then MsgBox "You can only create an ARCS for days in the past. Enter a date before today." Else dayReal = True End If End If Loop strFirstDay = CStr(firstDayNo) If strFirstDay = "" Then ThisWorkbook.Close Else Set olNs = GetNamespace("MAPI") Set f = olNs.Folders("WFM") Set subf = f.Folders("Inbox") Set userf = subf.Folders("Five9 Reports") 'This line will throw a run-time error Set five9 = userf.Items Set five9rng = five9.restrict("[ReceivedTime]>'" & Format(newdate + 1, "DDDDD HH:NN") & "'") Set five9rng = five9rng.restrict("[ReceivedTime]<'" & Format(newdate + 2, "DDDDD HH:NN") & "'") Set wbPaste = ActiveWorkbook