Question

我想知道你们是否可以帮助我。我们最近从Outlook 2003迁移到2010年。我们使用Outlook VBA脚本来获取特定的传入电子邮件表单，读取它们，提取信息并将其编译到文件中。

该脚本有效，但它只读取文件夹中的一半消息。我对文件夹进行了计数测试，并且显示了正确的数字，但由于某种原因，我使用的for循环仅在一半的项目上执行。因此，如果文件夹中有8条消息，那么它只读取其中的4条，如果有4条，那么它只读取2条，等等......

我无法弄清楚我的代码的哪一部分是轰炸。任何帮助将不胜感激。我只发布了代码的for循环部分。如果你需要整个剧本，请告诉我。

enter code here    Set myOlApp = CreateObject("Outlook.Application") 'Outlook App Obj.
Set myNameSpace = myOlApp.GetNamespace("MAPI") 'MAPI Namespace
Set myFolder = myNameSpace.Folders("myemail@mydomain").Folders("TestAccMail") 'Outlook folder to access

For Each Item In myFolder.Items 'Loop through each mail item
    If (regex.Test(Item.Subject)) Then 'Test for TestAccX Message
        strDataSplit = Split(Item.Body, vbNewLine) 'Split the contents of the body to an array
        strOutput = ""
        For Each arrItem In strDataSplit 'Loop through the contents of the e-mail body
            If (regExData.Test(arrItem)) Then 'Test if line contains a field we need
                field = Split(arrItem, ":")(1) 'Store the value of the field
                strOutput = strOutput & Trim(Replace(field, Chr(160), "")) & "|" 'Concat the previous field value with current; seperated by |
            End If
        Next arrItem 'Next field in array

        If Not strOutput = "" Then 'Ensure the output var has data
            WriteToATextFile strOutput, file 'Append the data record to the provided file
            Item.Move myFolder.Folders("TestAcc Complete") 'Move mail item to completed folder
            recCount = recCount + 1
        Else 'If the string is blank, no data was extracted; Error!
            Item.Move myFolder.Folders("Errors") 'Move mail item to Error folder
            errCount = errCount + 1 'Incremeant error count
        End If
        messCount = messCount + 1 'Incremeant message count, error or not
    End If
Next 'Next TestAccX Message

Answer 1

我不确定VBA如何处理集合，但我猜你何时从myFolder移动项目，你实际上是在集合中“跳过”。正确的语言不允许您更改每个循环正在处理的集合。

VBA For Loop无法按预期工作

1 个答案: