PDA

View Full Version : Solved: Parse email body for email addresses and write them to Excel...Help with Troubleshoot



joshua.omary
07-31-2010, 10:45 AM
Hi,

I have written a script that parses the bodies of emails for email addresses and writes them to an Excel spreadsheet. I am using a regex to match and an array to store the strings. The script works great except for the three issues below.

BTW, this is being used to get the addresses out of returned mail failures so they can be removed from our database. I only have about 3000+ failures....lol

Issue 1:
I have the all the failure notices in an archive folder to remove them from the server until parsing and then deletion. For the life of me, I cannot reference the archive PST folder. :banghead: It always defaults to the Personal Folders / Inbox / Folder Name Here. The actual path is Archive E-Mails / Inbox / Mail Failures.

Issue 2:
Currently, I have it set to a test folder inside the default inbox labeled "Test". Sometimes it runs fine and sometimes Outlook quits responding and had to be manually shut down. It has never run properly with more than 30 emails in the folder. Even then it's hit and missif it works. Remember I have 3000+ emails that need to be parsed.:dunno

Issue 3:
This should be simple. I would like the output to be to the same Excel file each time, create a new sheet, and plug in the date in A1. Simply for tracking purposes.

I am not asking someone to do the work for me, but please point me in the right direction to fix these issues. My script is realy useless to me without a minimum of issue 2 being corrected. Thank you in advance for everyones help and input.


Sub badAddress()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim regEx As Object
Dim olMatches As Object
Dim strBody As String
Dim bcount As String
Dim lFirstPos As Long
Dim lLastPos As Long
Dim badAddresses As Variant
Dim i As Long
Dim xlApp As Object 'Excel.Application
Dim xlwkbk As Object 'Excel.Workbook
Dim xlwksht As Object 'Excel.Worksheet
Dim xlRng As Object 'Excel.Range
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderInbox).Folders("Test")
Set regEx = CreateObject("VBScript.RegExp")
'define regular expression
regEx.Pattern = "[\_]*([a-z0-9]+(\.|\_*)?)+@([a-z][a-z0-9\-]+(\.|\-*\.))+[a-z]{2,6}"
regEx.IgnoreCase = True
regEx.Multiline = True
' set up size of variant
bcount = olFolder.Items.Count
ReDim badAddresses(1 To bcount) As String
' initialize variant position counter
i = 0
' parse each message in the folder holding the bounced emails
For Each Item In olFolder.Items
i = i + 1
strBody = Item.Body
Set olMatches = regEx.Execute(strBody)
If olMatches.Count >= 1 Then
badAddresses(i) = olMatches(0)
End If
Next
' write everything to Excel
Set xlApp = GetExcelApp
If xlApp Is Nothing Then GoTo ExitProc
Set xlwkbk = xlApp.Workbooks.Add
Set xlwksht = xlwkbk.Sheets(1)
Set xlRng = xlwksht.Range("A1")
xlApp.ScreenUpdating = False
xlRng.Value = "Bounced email addresses"
' resize version
xlRng.Offset(1, 0).Resize(UBound(badAddresses) + 1).Value = xlApp.Transpose(badAddresses)
xlApp.Visible = True
xlApp.ScreenUpdating = True
ExitProc:
Set xlRng = Nothing
Set xlwksht = Nothing
Set xlwkbk = Nothing
Set xlApp = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
Set badAddresses = Nothing
End Sub
Function GetExcelApp() As Object
' always create new instance
On Error Resume Next
Set GetExcelApp = CreateObject("Excel.Application")
On Error GoTo 0
End Function

JP2112
08-13-2010, 05:35 PM
With Regex, you are getting the first available email address. Whether that is the bounced email address remains to be seen, because some bouncebacks list both the intended (failed) recipient and the sender's email addresses.

Issue 1:
The reason your code points to the default Inbox is because you are using the GetDefaultFolder Method:

olNS.GetDefaultFolder(olFolderInbox).Folders("Test")

Use the Folders Collection to walk down the non-default folder hierarchy, like this:

olNS.Folders("Archive E-Mails").Folders("Inbox").Folders("Mail Failures")

Issue 2:
Try stepping through the code.

Issue 3:

Change this line:

xlApp.Workbooks.Add

to

xlApp.Workbooks.Open (your filename here)

joshua.omary
08-19-2010, 11:48 AM
JP2112,

I made the code changes you recommended. I also added a line to mark the mail item as unread.

Previous:

' parse each message in the folder holding the bounced emails
For Each Item In olFolder.Items
i = i + 1
strBody = Item.Body
Set olMatches = regEx.Execute(strBody)
If olMatches.Count >= 1 Then
badAddresses(i) = olMatches(0)
End If
Next


Current:

' parse each message in the folder holding the bounced emails
For Each Item In olFolder.Items
i = i + 1
strBody = Item.Body
Set olMatches = regEx.Execute(strBody)
If olMatches.Count >= 1 Then
badAddresses(i) = olMatches(0)
Item.UnRead = False
End If
Next


I used "Step Into" to run each line one by one. I get to the loop and it does just that....It loops, and each time the unread count goes down by one. I do not know how to break out of the loop to continue with the rest of the code. I also notice that it is not starting with the youngest mail item. It starts about 1/16th of the way down the list each time. I don't know if this info is useful or not.

Here is the problem. After testing it seems that it is finding the proper folder and running through the loop, so I try running the macro (F5). As soon as I do the cursor changes to the hour glass, unread item count does not change, and Outlook becomes unresponsive. I then have to manually shut down and restart Outlook. I am now very confused and have no idea what to do.

Thank you and anyone else for helping. I have another mass mailer in a week and I have to get these addresses removed from our database.

Joshua

joshua.omary
08-19-2010, 11:55 AM
I forgot to post the fully revised code so here it is:


Sub badAddress()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim regEx As Object
Dim olMatches As Object
Dim strBody As String
Dim bcount As String
Dim lFirstPos As Long
Dim lLastPos As Long
Dim badAddresses As Variant
Dim i As Long
Dim xlApp As Object 'Excel.Application
Dim xlwkbk As Object 'Excel.Workbook
Dim xlwksht As Object 'Excel.Worksheet
Dim xlRng As Object 'Excel.Range

Set olApp = Outlook.Application

Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.Folders("Archived E-Mail").Folders("Inbox").Folders("Mail Failures")
Set regEx = CreateObject("VBScript.RegExp")

'define regular expression
regEx.Pattern = "[\_]*([a-z0-9]+(\.|\_*)?)+@([a-z][a-z0-9\-]+(\.|\-*\.))+[a-z]{2,6}"
regEx.IgnoreCase = True
regEx.Multiline = True

' set up size of variant
bcount = olFolder.Items.Count
ReDim badAddresses(1 To bcount) As String

' initialize variant position counter
i = 0

' parse each message in the folder holding the bounced emails
For Each Item In olFolder.Items
i = i + 1
strBody = Item.Body
Set olMatches = regEx.Execute(strBody)
If olMatches.Count >= 1 Then
badAddresses(i) = olMatches(0)
Item.UnRead = False
End If
Next

' write everything to Excel
Set xlApp = GetExcelApp
If xlApp Is Nothing Then GoTo ExitProc

Set xlwkbk = xlApp.Workbooks.Open("My Folder Path Goes Here.")
Set xlwksht = xlwkbk.Sheets(1)
Set xlRng = xlwksht.Range("A1")

xlApp.ScreenUpdating = False
xlRng.Value = "Bounced email addresses"

' resize version
xlRng.Offset(1, 0).Resize(UBound(badAddresses) + 1).Value = xlApp.Transpose(badAddresses)
xlApp.Visible = True
xlApp.ScreenUpdating = True

ExitProc:
Set xlRng = Nothing
Set xlwksht = Nothing
Set xlwkbk = Nothing
Set xlApp = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
Set badAddresses = Nothing
End Sub

Function GetExcelApp() As Object
' always create new instance
On Error Resume Next
Set GetExcelApp = CreateObject("Excel.Application")
On Error GoTo 0
End Function

joshua.omary
08-21-2010, 03:07 PM
I have found out why my script freezes and I have to force quit Outlook. The index of the items in the folder do not run from 1 to 10. For example, the first email in the folder might have an index of 7. That means this is the actual pattern of the indexes; 7,8,9,10,1,2,3,4,5,6. The loop will still start with index 1 and try to go to index 10, but it will freeze once it tries to parse the body on index 7. The strBody variable still loads the body from index 7.....I don't have a clue at this point. I know when the indexes coincide perfectly from top to bottom and 1 to 10, the script runs perfectly.

NOTE: The index numbers above are strictly for example. I have total of 3,137 emails.

Updated Code w/error notes

Option Explicit
Sub badAddress()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim Item As MailItem
Dim regEx As Object
Dim olMatches As Object
Dim strBody As String
Dim bcount As String
Dim badAddresses As Variant
Dim i As Long
Dim xlApp As Object 'Excel.Application
Dim xlwkbk As Object 'Excel.Workbook
Dim xlwksht As Object 'Excel.Worksheet
Dim xlRng As Object 'Excel.Range
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.Folders("Archived E-Mail").Folders("Inbox").Folders("Mail Failures")
Set regEx = CreateObject("VBScript.RegExp")
'define regular expression
regEx.Pattern = "[\_]*([a-z0-9]+(\.|\_*)?)+@([a-z][a-z0-9\-]+(\.|\-*\.))+[a-z]{2,6}"
regEx.IgnoreCase = True
regEx.Multiline = True
' set up size of variant
bcount = olFolder.Items.Count
ReDim badAddresses(1 To bcount) As String
' initialize variant position counter
i = 0
' parse each message in the folder holding the bounced emails
For Each Item In olFolder.Items
i = i + 1
strBody = olFolder.Items(i).Body
Set olMatches = regEx.Execute(strBody) 'FREEZES HERE WHEN THE INDEX NUMBER RETURNS TO THE START OF THE FOLDER
If olMatches.Count >= 1 Then
badAddresses(i) = olMatches(0)
Item.UnRead = False
End If
Next Item
' write everything to Excel
Set xlApp = GetExcelApp
If xlApp Is Nothing Then GoTo ExitProc
If Not IsFileOpen("myxlsfile.xls") Then
Set xlwkbk = xlApp.workbooks.Open("myxlsfile.xls")
End If
Set xlwksht = xlwkbk.Sheets(1)
Set xlRng = xlwksht.Range("A1")
xlApp.ScreenUpdating = False
xlRng.Value = "Bounced email addresses"
' resize version
xlRng.Offset(1, 0).Resize(UBound(badAddresses) + 1).Value = xlApp.Transpose(badAddresses)
xlApp.Visible = True
xlApp.ScreenUpdating = True
ExitProc:
Set xlRng = Nothing
Set xlwksht = Nothing
Set xlwkbk = Nothing
Set xlApp = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
Set badAddresses = Nothing
End Sub
Function GetExcelApp() As Object
' always create new instance
On Error Resume Next
Set GetExcelApp = CreateObject("Excel.Application")
On Error GoTo 0
End Function

'Thanks to xld for the following function vbaexpress forums.
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0

Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function


I hope I was detailed enough with my explaination. Someone please help me. PLEASE!!!!!!!!!!!!!!!! I have been working on this for almost a month now.

Thanks,

Joshua

Crocus Crow
08-22-2010, 03:20 PM
I ran your code and Outlook also froze (it went to 95% CPU) on this line:

Set olMatches = regEx.Execute(strBody) 'FREEZES HERE WHEN THE INDEX NUMBER RETURNS TO THE START OF THE FOLDER

So I suspect there is something wrong with your regular expression to catch email addresses. Sure enough, when I used the one from http://www.regular-expressions.info/regexbuddy/email.html, i.e.:

regEx.Pattern = "\b[A-Z0-9._%-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"

The code ran without problems.

No idea what you mean by "index of the items in the folder do not run from 1 to 10". Are you talking about the 'i' variable in your For Next loop? That will always go from 1 to n where n is number of emails in olFolder.items (i.e. olFolder.items.count).

joshua.omary
08-22-2010, 05:20 PM
Thanks for the reply. The code works just fine for me also.....when certain criteria is met. Yes, the index of the mailitem is referenced using the "i" variable. Search google for "outlook vba mailitem" and the first result will give you more details. I would include a link but I have not posted enough times yet.


Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.Folders("Archived E-Mail").Folders("Inbox").Folders("Mail Failures")
Set Item = olFolder.Items(2)
Item.Display

The code above should open the second email in the folder by referencing its index. This is where my problem occurs. Index #1 is not always the first email in the folder. The index numbering will still run consecutively but once it reaches the end of the folder it starts back at the top. View examples below.

Ex.A: Fails at index 7 but Starts at index 1
Start of Folder
email 1 - index 7
email 2 - index 8
email 3 - index 9
email 4 - index 10
email 5 - index 1
email 6 - index 2
email 7 - index 3
email 8 - index 4
email 9 - index 5
email 10 - index 6
End of Folder


Ex.B: Works Great
Start of Folder
email 1 - index 1
email 2 - index 2
email 3 - index 3
email 4 - index 4
email 5 - index 5
email 6 - index 6
email 7 - index 7
email 8 - index 8
email 9 - index 9
email 10 - index 10
End of Folder

I added a msgbox at different stages of the loop to test each variable. I also marked all items as unread and added Item.UnRead = False just before it looped to the next item. This showed me where the looped started and failed in the folder. I then used the script above to test each mailitem's index number. This is when I noticed that ex. A always failed and ex. B worked like a champ. To take it one step further I added a msgbox to test the strBody variable. When it came around to index 7, the strBody variable did contain the body string and it froze once it tried to parse to string. I assumed something in the body was conflicting with the regEx, so I moved items with index 1 - 6 to another folder leaving only first four items. Again, I used the script above to see if 7 - 10 became 1 - 4 and they did. Re-ran my primary script and it worked perfectly. It parsed the "problem" email plus all the rest with no issues. I am no expert, but I do not know how the regEx would be causing this issue. Again, I am no expert.

I do know that everytime the mailitem index are like ex. A, it always freezes on the mailitem that returns to the top of the folder. This is the line of code that freezes:


Set olMatches = regEx.Execute(strBody)


I am sorry if I am not being clear. I do not know any other way to explain it. I do know that I have done alot of testing and if you can recreate the out of order indexes it will freeze as stated above.

Is there any way to reset the mailitem index to match the order of emails in the folder??? I think that would fix all my problems. I spent many hours searching could not find anything that resembled this problem.

Thank you again for your help,

Joshua


PS - The index counts above are examples only. They do not represent the actual amount of emails I am in need of parsing.

joshua.omary
08-22-2010, 06:04 PM
@ Crocus Crow

I did change the regEx to the one you suggested and five minutes later there is my excel file with all 3,137 bad email addresses. You are the freaking man. I still do not know why the other one would cause it to fail when the conditions were as stated above, but it works now and I don't care.

Fully Functioning Script - Marks items as read when completed.

Option Explicit
Sub badAddress()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim Item As MailItem
Dim regEx As Object
Dim olMatches As Object
Dim strBody As String
Dim bcount As String
Dim badAddresses As Variant
Dim i As Long
Dim xlApp As Object 'Excel.Application
Dim xlwkbk As Object 'Excel.Workbook
Dim xlwksht As Object 'Excel.Worksheet
Dim xlRng As Object 'Excel.Range
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.Folders("Archived E-Mail").Folders("Inbox").Folders("Mail Failures")
Set regEx = CreateObject("VBScript.RegExp")
'define regular expression
regEx.Pattern = "\b[A-Z0-9._%-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
regEx.IgnoreCase = True
regEx.Multiline = True
' set up size of variant
bcount = olFolder.Items.Count
ReDim badAddresses(1 To bcount) As String
' initialize variant position counter
i = 0
' parse each message in the folder holding the bounced emails
For Each Item In olFolder.Items
i = i + 1
strBody = olFolder.Items(i).Body
Set olMatches = regEx.Execute(strBody)
If olMatches.Count >= 1 Then
badAddresses(i) = olMatches(0)
Item.UnRead = False
End If
Next Item
' write everything to Excel
Set xlApp = GetExcelApp
If xlApp Is Nothing Then GoTo ExitProc
If Not IsFileOpen("YourExcelFileHere.xls") Then
Set xlwkbk = xlApp.workbooks.Open("YourExcelFileHere.xls")
End If
Set xlwksht = xlwkbk.Sheets(1)
Set xlRng = xlwksht.Range("A1")
xlApp.ScreenUpdating = False
xlRng.Value = "Bounced email addresses"
' resize version
xlRng.Offset(1, 0).Resize(UBound(badAddresses) + 1).Value = xlApp.Transpose(badAddresses)
xlApp.Visible = True
xlApp.ScreenUpdating = True
ExitProc:
Set xlRng = Nothing
Set xlwksht = Nothing
Set xlwkbk = Nothing
Set xlApp = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
Set badAddresses = Nothing
End Sub
Function GetExcelApp() As Object
' always create new instance
On Error Resume Next
Set GetExcelApp = CreateObject("Excel.Application")
On Error GoTo 0
End Function
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0

Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function




Thank you everyone so much for all your help!!!!!!!!!!!!

Joshua

prophecym
01-22-2013, 05:20 PM
Hi,

I know this is a solved and old post. However, I am having this error when I try running the code in Excel:


Compile Error:

User-defined type not defined

I can't figure out what seems to be the problem. Any advise is appreciated.

skatonni
02-23-2013, 03:34 PM
Run the code from Outlook not Excel

beginner5
04-16-2014, 08:33 AM
Hi

when I use this last code from Joshua, I get an error 53. It does not find my excel sheet to put the email addresses in. But the name of the excel file is correct. What could be the reason for this? Do I need to put the excel sheet in a specific location so that the script does find it?

Thanks in advance

westconn1
04-16-2014, 02:21 PM
do you give the full path to the excel file?

beginner5
04-17-2014, 12:04 AM
do you give the full path to the excel file?

This is my code regarding the excel name and path:




...
Next Item
' write everything to Excel
Set xlApp = GetExcelApp
If xlApp Is Nothing Then GoTo ExitProc
If Not IsFileOpen("liste_bounced_emails.xls") Then
Set xlwkbk = xlApp.workbooks.Open("liste_bounced_emails.xls")
End If

....

westconn1
04-17-2014, 02:49 AM
yes, you need to give full path to excel file, not just filename

beginner5
04-17-2014, 03:13 AM
yes, you need to give full path to excel file, not just filename

How do I do this in vba language, if the file is on my desktop?

mancubus
04-17-2014, 04:43 AM
Set xlwkbk = xlApp.Workbooks.Open(Environ("USERPROFILE") & "\Desktop\liste_bounced_emails.xls")

westconn1
04-17-2014, 05:59 AM
you also need to change it in isfileopen as that function is generating the error 53

beginner5
04-19-2014, 12:12 AM
you also need to change it in isfileopen as that function is generating the error 53

H

thank you all for your help. That worked now perfectly!

But now something strange is happening: I used the exact same code now for a different email folder. I want to do the exact same thing, just with a different outlook folder. Same excel sheet (which is now empty) etc.

So I changed the name of the outlook folder. The vba code also finds this outlook folder. But suddenly I get an error 13 "type mismatch".

When I click on debug, it highlight me the "Next Item" in the line "Next Item" in the first line where it wants to go to excel:


...
Next Item
' write everything to Excel
Set xlApp = GetExcelApp
If xlApp Is Nothing Then GoTo ExitProc
If Not IsFileOpen(Environ("USERPROFILE") & "\Desktop\liste_bounced_emails.xlsx") Then
Set xlwkbk = xlApp.Workbooks.Open(Environ("USERPROFILE") & "\Desktop\liste_bounced_emails.xlsx")
End If

....

I do not understand this. It is the exact same code, same excel sheet etc. Why there is now an error, what worked perfectly 5 minutes ago? In this folder, there are over 2400 bounced emails.

What could be the reason for this and how can I fix this?11588

fokrow
04-20-2014, 10:00 AM
So I changed the name of the outlook folder. The vba code also finds this outlook folder. But suddenly I get an error 13 "type mismatch".

Same thing happened to me but I figured out that not everything in my folder was a mailitem so I changed…

Dim Item As MailItem

to

Dim Item As Object

and now it works!

beginner5
04-20-2014, 01:57 PM
Same thing happened to me but I figured out that not everything in my folder was a mailitem so I changed…

Dim Item As MailItem

to

Dim Item As Object

and now it works!

Thank you very much! This was the reason for my error 13. Now it works!

YESMUN
11-19-2014, 07:17 AM
Hi Guys

This is an awesome script, works brilliantly.

Is there a way to make it collect multiple emails out of the body of an email instead of stopping at the first one?

thank you for any assistance.

gmayor
11-19-2014, 07:25 AM
Do you mean multiple email ADDRESSES from the body of a message. Take a look at http://www.gmayor.com/extract_data_from_email.htm for an approach that can easily be configured to do so - also see http://www.gmayor.com/extract_email_data_addin.htm
(http://www.gmayor.com/extract_email_data_addin.htm)

YESMUN
11-19-2014, 08:09 AM
Hi gmayor, thank you for the links, those look very useful.

What I am looking for is exactly the script on here, but instead of it just removing the first email I need to it extract all the email addresses in the body of the email.
This script seems to stop after it gets the first email address.

Thank you for your help.

westconn1
11-21-2014, 01:00 AM
this is not my script and i have not tested this modification, but try like


ReDim badAddresses(1 to 1) As String
' initialize variant position counter
i = 1
' parse each message in the folder holding the bounced emails
For Each Item In olFolder.Items

strBody = olFolder.Items(i).Body
Set olMatches = regEx.Execute(strBody)
If olMatches.Count >= 1 Then
redim preserve badaddresses(1 to ubound(badaddresses) + olmatches.count - 1) ' check this gives correct result
for m = 0 to olmatches.count -1
badAddresses(i) = olMatches(m)
i = i + 1
Item.UnRead = False
next
End If
Next Item

YESMUN
11-21-2014, 02:30 AM
Hi westconn1, thank you for that, unfortunately it still stops after finding the first email address.

westconn1
11-21-2014, 02:56 AM
you need an extra line when setting the regex options


regex.Global = Truei tested it will then return all matches, instead of just the first

YESMUN
11-21-2014, 03:28 AM
AWESOME AWESOME AWESOME, That works.
Thank you sooooooo much for your help.

YESMUN
11-21-2014, 03:45 AM
Oh dear it has a problem, if there is more that one email in the folder then it doesn't extract any email addresses, but if there is only one email in the folder then it extracts all the email addresses correctly.

westconn1
11-21-2014, 04:26 AM
you need to use the original code posted before, with just the small part i changed in place of the original
make sure to use the correct folder path
check the array is still correct immediately after redim preserve

post your entire code, as i do not see any reason, in any of the codes posted, why such a problem should be occurring
there are probably some errors in the suggested code, but they would cause errors to occur, not just wrong results, unless some inappropriate error handling

YESMUN
11-21-2014, 05:19 AM
It wont let me post the full code, says post denied.

It runs through fine with one email in the selected folder, if I put more than one email into the folder it comes up with an error:

Run-time Error 440 - Array index out of bounds - and highlights this line: "strBody = olFolder.Items(i).Body" when I say debug.

thank you so much for you help.

westconn1
11-21-2014, 05:31 AM
that line should be

strBody = Item.Body

it would appear i must have copied and pasted code from post #5 as the code in all other posts seem to have it correct

YESMUN
11-21-2014, 05:49 AM
ok that worked, now there is another error, i have attached a screenshot.

12524

westconn1
11-21-2014, 01:32 PM
try changing to

redim badaddresses(0) on line 3

arvind87
03-06-2017, 01:30 AM
Dear , I am using this code and run perfectly but emails not showing in excel sheet.