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