皆さんが私を助けてくれるかどうか疑問に思っていました。最近、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