Question

我写了一个脚本来帮助我做一些资源规划。它通过共享的Outlook收件箱查看我们何时收到最多的电子邮件，以及何时应该避免任何中断等。

它似乎工作得很好，但偶尔会抛出一个随机错误（类型不匹配，调用失败，操作失败等）。当我从错误消息运行调试器时，它正常进行。它每次都会在错误之间传递大约800条消息，如果情绪良好，则会传递更多信息。

我能想到的是，有时不同的子文件夹需要花费一些时间来加载。我的代码如下，有什么我可以添加它让它等待片刻从服务器加载消息？

提前致谢。

在sub：

中调用循环

For Each msg In StartFolder.Items
    DoEvents
    msgData = ripData(msg)
    written = toExcel(msgData, strExcelFilePath)
Next

下面定义的函数：

Function ripData(msg As Outlook.MailItem) As Variant
 Dim V() As Variant
 ReDim V(1 To 10)
 Dim minutes As Integer

 DoEvents

 V(1) = msg.Sender

 If InStr(1, msg.Sender.Address, "@", 1) > 1 Then
    V(2) = Mid(msg.Sender.Address, InStr(1, msg.Sender.Address, "@", 1))
 Else
    V(2) = "insight.com"
 End If

 V(3) = Format(msg.ReceivedTime, "short date")
 V(4) = Format(msg.ReceivedTime, "DDDD")
 V(5) = Format(msg.ReceivedTime, "dd")
 V(6) = Format(msg.ReceivedTime, "MMMM")
 V(7) = Format(msg.ReceivedTime, "yyyy")
 V(8) = Format(msg.ReceivedTime, "hh:mm")
 V(9) = Format(msg.ReceivedTime, "hh")
 minutes = Split(Format(msg.ReceivedTime, "hh:mm"), ":")(1)
 If minutes < 15 Then
     V(10) = 1
 ElseIf minutes < 30 Then
     V(10) = 2
 ElseIf minutes < 45 Then
     V(10) = 3
 Else
     V(10) = 4
 End If

 ripData = V
End  Function 

Function toExcel(data As Variant, excelFName As String) As Boolean
 Dim fso As New FileSystemObject
 Dim spath As String, sFileName As String, fileWithoutExt As String, lrow As Long
 Dim i As Long
 Dim myWB As Object, oXLWs As Object

 sFileName = fso.GetFileName(excelFName)

 fileWithoutExt = sFileName


 Set myWB = FindOpenExcel(excelFName, fileWithoutExt, sFileName)

 Set oXLWs = myWB.Sheets("Raw Data")

 lrow = oXLWs.Range("A1048576").End(xlUp).Row + 1

 '~~> Write to excel
 For i = 1 To UBound(data)
    oXLWs.Cells(lrow, i).Value = data(i)
 Next i

End Function

Answer 1

类型不匹配意味着您假设所有项目都是MailItem对象，但收件箱文件夹可以包含其他项目类型的ReportItem，MeetingItem等）。检查Class属性，确保你有预期的对象 - 对于MailItem对象，它将是43（olMail）。

其次，您可能打开了太多项目 - Exchange限制了同时打开的对象的数量。加上“for each”循环使所有集合元素都被引用，直到循环退出。使用“for”循环

dim oItems
oItems = StartFolder.Items
dim I As Integer
dim msg As Object
For I = 1 to oItems.Count
    set msg = oItems.Item(I)
    if msg.Class = 43 Then
      msgData = ripData(msg)
      written = toExcel(msgData, strExcelFilePath)
    End If
    set msg = Nothing
Next

Answer 2

如果没有为共享文件夹设置缓存（帐户设置），则可以间歇性地获取操作失败错误。

放慢vba以考虑网络滞后（展望）

2 个答案: