尝试在vba / sql中保存附件时,数组超出范围错误

时间:2014-07-21 09:30:14

标签: arrays vba outlook

我设法获取了保存附件的代码,但是现在我已经为它设置了一些条件,我一直在使数组超出界限错误。我确实把附件.item作为(x),但我的同事建议这不会起作用。无论如何,我以为我会问专家。

当我在调试模式下运行时,attachments.item(x)从1直接变为820。

以下是我的代码片段:

对于i = 1 To EmailCount     使用ObjParentFolder.Items(i)

    If .MessageClass = "IPM.Note" And .ReceivedTime >= teste Then
        Found = False
        If PreviousRex = True Then
            For x = 0 To RexCnt
                If .SenderName = Data(x).Sender And .ReceivedTime = Data(x).Received Then
                    Found = True
                End If
            Next x
        End If
        If Found = False Then
                    rex.AddNew
                        rex.Fields("MailItemPath") = ObjParentFolder.Name
                        rex.Fields("ReceivedTime") = .ReceivedTime
                        rex.Fields("MailDate") = DateValue(.ReceivedTime)
                        rex.Fields("MailHour") = Left(TimeValue(.ReceivedTime), 2)
                        rex.Fields("Subject") = .Subject
                        rex.Fields("SenderName") = .SenderName
                        rex.Fields("MSGBody") = .Body
                        rex.Fields("Last_Updated") = Now
                        rex.Fields("Updated_By") = UCase(CurrentUserName())
                        rex.Fields("new") = True
                        rex.Fields("W_ID") = prop & rex.Fields("ID")
                        TmpID = rex.Fields("W_ID")
                    rex.Update


        End If

        'If .Attachments.Count > 0 Then
        '   For p = 1 To .Attachments.Count
        '       Select Case Right(.Attachments.Item(p).Filename, 4)
        '           Case ".xls"
        '               .Attachments.Item(p).SaveAsFile (ThisWorkbook.Path & "\attachments" & "_" & TmpID & "_" & .Attachments.Item(p).Filename)
        '          Case ".zip"
        '                .Attachments.Item(p).SaveAsFile (ThisWorkbook.Path & "\attachments" & "_" & TmpID & "_" & .Attachments.Item(p).Filename)
        '            Case ".doc"
        '                .Attachments.Item(p).SaveAsFile (ThisWorkbook.Path & "\attachments" & "_" & TmpID & "_" & .Attachments.Item(p).Filename)
        '            Case Else
        '                .Attachments.Item(p).Delete
        '       End Select
        '   Next p
        'End If
    End If
End With

接下来我

1 个答案:

答案 0 :(得分:0)

您正在循环中删除附件,从而更改总计数。使用下行循环:

For p = .Attachments.Count to 1 step -1

避免使用多点符号也是一个好主意。在进入循环之前缓存附件集合并仅检索附件

昏暗的附件 昏暗的附着 set attachments = .Attachments 如果attachments.Count> 0然后

       For p = .Attachments.Count to 1 step -1
           set attach = attachments.Item(p)
           Select Case Right(attach.Filename, 4)
               Case ".xls"
                   attach.SaveAsFile (ThisWorkbook.Path & "\attachments" & "_" & TmpID & "_" & attach.Filename)
              Case ".zip"
                    attach.SaveAsFile (ThisWorkbook.Path & "\attachments" & "_" & TmpID & "_" & attach.Filename)
                Case ".doc"
                    attach.SaveAsFile (ThisWorkbook.Path & "\attachments" & "_" & TmpID & "_" & attach.Filename)
                Case Else
                    attach.Delete
           End Select
       Next p
    End If