Cycling through every Email in a Folder and Appending data..

Hi,

I am using the following code to cycle through every email in a
specific folder and then parse data to a text file. The code skips
emails though. In the middle of the code, you will see a line that
says 'MsgBox MyItems.Count'. This returns the correct number of items
in my mailbox, but when I run the code, it does not parse every email
into the text file. Sometimes it skips 1, or 2. It is not
consistent. Every email is the same. They are generated by a website
and sent to me.


Sub LogInformation()

Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim MyItems As Outlook.Items
Dim MyFolder As Outlook.Folder
Dim arrdata() As Variant
Dim Msg As Outlook.MailItem
Dim FileNum As Integer
Dim MsgBody As String
Dim MsgLines As Variant
Dim MsgLine As Variant
Dim FirstRecord As Integer
Dim MostRecentDate As Date
Dim NextDate As Date
Dim I As Integer


Const FeedbackScores As String = "Q:\Operations\Feedback Scores.LOG"


Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set MyFolder =
olNS.GetDefaultFolder(olFolderInbox).Folders.Item("Feedback")
Set MyItems = MyFolder.Items

FileNum = FreeFile
FirstRecord = 1

Open FeedbackScores For Input Lock Write As #FileNum

Do Until EOF(FileNum)
Line Input #FileNum, Data
If Mid(Data, 3, 1) = "/" Then
If FirstRecord = 1 Then
MostRecentDate = Data
FirstRecord = FirstRecord + 1
Else
NextDate = Data
FirstRecord = FirstRecord + 1
If NextDate > MostRecentDate Then
MostRecentDate = NextDate
End If
End If
End If
Loop

Close #FileNum

I = 1

Open FeedbackScores For Append As #FileNum

MsgBox MyItems.Count

For I = 1 To MyItems.Count
Set Msg = MyItems.Item(I)
MsgBody = Msg.Body
MsgLines = Split(MsgBody, vbCrLf)
For Each MsgLine In MsgLines
If InStr(1, MsgLine, "Overall service rating",
vbTextCompare) Then
Print #FileNum, MsgLine
Print #FileNum, Left(Msg.Subject, 4)
End If
If InStr(1, MsgLine, "Assisting Agent Name:",
vbTextCompare) Then
Print #FileNum, MsgLine
End If
If InStr(1, MsgLine, "Additional Comments", vbTextCompare)
Then
Print #FileNum, MsgLine
Print #FileNum, Msg.ReceivedTime
End If

Next
I = I + 1
Next

MsgBox I

Close #FileNum


End Sub

On Sep 25, 12:23 pm, "Ken Slovak - [MVP - Outlook]"
<kenslo....TakeThisOut@mvps.org> wrote:
>  I = I + 1
>
> You are incrementing the loop counter within the loop. Don't do that. Let
> the For loop increment it's own counter. Without a Step clause it's doing a
> Step 1 anyway.
>
> --
> Ken Slovak
> [MVP - Outlook]http://www.slovaktech.com
> Author: Professional Programming Outlook 2007.
> Reminder Manager, Extended Reminders, Attachment Options.http://www.slovaktech.com/products.htm
>
> "R Tanner" <tanner.ro....TakeThisOut@gmail.com> wrote in message
>
> news:28efad00-8cde-4265-a4a3-97e810500183@n33g2000pri.googlegroups.com...
>
>
>
> > Hi,
>
> > I am using the following code to cycle through every email in a
> > specific folder and then parse data to a text file.  The code skips
> > emails though.  In the middle of the code, you will see a line that
> > says 'MsgBox MyItems.Count'.  This returns the correct number of items
> > in my mailbox, but when I run the code, it does not parse every email
> > into the text file.  Sometimes it skips 1, or 2.  It is not
> > consistent.  Every email is the same.  They are generated by a website
> > and sent to me.
>
> > Sub LogInformation()
>
> > Dim olApp As Outlook.Application
> > Dim olNS As Outlook.NameSpace
> > Dim MyItems As Outlook.Items
> > Dim MyFolder As Outlook.Folder
> > Dim arrdata() As Variant
> > Dim Msg As Outlook.MailItem
> > Dim FileNum As Integer
> > Dim MsgBody As String
> > Dim MsgLines As Variant
> > Dim MsgLine As Variant
> > Dim FirstRecord As Integer
> > Dim MostRecentDate As Date
> > Dim NextDate As Date
> > Dim I As Integer
>
> > Const FeedbackScores As String = "Q:\Operations\Feedback Scores.LOG"
>
> > Set olApp = Outlook.Application
> > Set olNS = olApp.GetNamespace("MAPI")
> > Set MyFolder =
> > olNS.GetDefaultFolder(olFolderInbox).Folders.Item("Feedback")
> > Set MyItems = MyFolder.Items
>
> > FileNum = FreeFile
> > FirstRecord = 1
>
> > Open FeedbackScores For Input Lock Write As #FileNum
>
> > Do Until EOF(FileNum)
> >    Line Input #FileNum, Data
> >    If Mid(Data, 3, 1) = "/" Then
> >        If FirstRecord = 1 Then
> >            MostRecentDate = Data
> >            FirstRecord = FirstRecord + 1
> >        Else
> >            NextDate = Data
> >            FirstRecord = FirstRecord + 1
> >            If NextDate > MostRecentDate Then
> >                MostRecentDate = NextDate
> >            End If
> >        End If
> >    End If
> > Loop
>
> > Close #FileNum
>
> > I = 1
>
> > Open FeedbackScores For Append As #FileNum
>
> > MsgBox MyItems.Count
>
> > For I = 1 To MyItems.Count
> >    Set Msg = MyItems.Item(I)
> >        MsgBody = Msg.Body
> >        MsgLines = Split(MsgBody, vbCrLf)
> >        For Each MsgLine In MsgLines
> >           If InStr(1, MsgLine, "Overall service rating",
> > vbTextCompare) Then
> >                Print #FileNum, MsgLine
> >                Print #FileNum, Left(Msg.Subject, 4)
> >           End If
> >           If InStr(1, MsgLine, "Assisting Agent Name:",
> > vbTextCompare) Then
> >                Print #FileNum, MsgLine
> >           End If
> >           If InStr(1, MsgLine, "Additional Comments", vbTextCompare)
> > Then
> >                Print #FileNum, MsgLine
> >                Print #FileNum, Msg.ReceivedTime
> >           End If
>
> >        Next
> >        I = I + 1
> > Next
>
> > MsgBox I
>
> > Close #FileNum
>
> > End Sub- Hide quoted text -
>
> - Show quoted text -

duh. Okay Thank you Ken. Sometimes I wonder if I should really be
programming...