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.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.
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.
[VBA]
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
[/VBA]
Reply With Quote
Originally Posted by westconn1
