Cycling through every Email in a Folder and Appending data To a TextFile

[R Tanner]

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

 

[Ken Slovak - [MVP - Outlook]]

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.

 

[R Tanner]

 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 doinga
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

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...