我在Excel VBA中有一个脚本，用于在工作中的共享收件箱中的子文件夹中查找特定电子邮件。团队中的每个人都有自己的个人收件箱，然后我们都可以访问团队的单个收件箱。我在参考资料中检查了Outlook库。大部分时间它都在我的电脑上运行。当我的同事尝试运行脚本时，它有时会工作，但通常不会运行。然后，无论何时我在我的机器上运行它，它都会工作，然后在我的同事的机器上完全运行。
当脚本尝试将“userf”变量设置为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