How to replace 'at' with # - regex

Question

I have about 17k emails containing orders, news, contacts etc. going back 11 years.
Users' email addresses have been shoddily encrypted to stop crawlers and spam by changing the # to either *#* or 'at'.
I am trying to create a comma separated list to build a database of our users.
The code works with writing the file and looping the folders because if I write the senders email address to the file where I am currently using the body of the email then it prints fine.
The problem is, the Replaces aren't changing *at* etc to #.
First of all, why not?
Is there a better way for me to be doing this as a whole?
Private Sub Form_Load()
Dim objOutlook As New Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objInbox As MAPIFolder
Dim objFolder As MAPIFolder
Dim fldName As String
fldName = "TEST"
' Get the MAPI reference
Set objNameSpace = objOutlook.GetNamespace("MAPI")
' Pick up the Inbox
Set objInbox = objNameSpace.GetDefaultFolder(olFolderInbox)
'Loop through the folders under the Inbox
For Each objFolder In objInbox.Folders
RecurseFolders fldName, objFolder
Next objFolder
End Sub
Public Sub RecurseFolders(targetFolder As String, currentFolder As MAPIFolder)
If currentFolder.Name = targetFolder Then
GetEmails currentFolder
Else
Dim objFolder As MAPIFolder
If currentFolder.Folders.Count > 0 Then
For Each objFolder In currentFolder.Folders
RecurseFolders targetFolder, objFolder
Next
End If
End If
End Sub
Sub WriteToATextFile(e As String)
MyFile = "c:\" & "emailist.txt"
'set and open file for output
fnum = FreeFile()
Open MyFile For Append As fnum
Print #fnum, e; ","
Close #fnum
End Sub
Sub GetEmails(folder As MAPIFolder)
Dim objMail As MailItem
' Read through all the items
For i = 1 To folder.Items.Count
Set objMail = folder.Items(i)
GetEmail objMail.Body
Next i
End Sub
Sub GetEmail(s As String)
Dim txt = s
Do Until InStr(txt, "#") <= 0
Dim tleft As Integer
Dim tright As Integer
Dim start As Integer
Dim text As String
Dim email As String
text = Replace(text, " at ", "#", VbCompareMethod.vbTextCompare)
text = Replace(text, "'at'", "#", VbCompareMethod.vbTextCompare)
text = Replace(text, "*at*", "#", VbCompareMethod.vbTextCompare)
text = Replace(text, "*at*", "#", VbCompareMethod.vbTextCompare)
text = Replace(text, "<", " ", VbCompareMethod.vbTextCompare)
text = Replace(text, ">", " ", VbCompareMethod.vbTextCompare)
text = Replace(text, ":", " ", VbCompareMethod.vbTextCompare)
'one two ab#bd.com one two
tleft = InStr(text, "#") '11
WriteToATextFile Str(tleft)
WriteToATextFile Str(Len(text))
start = InStrRev(text, " ", Len(text) - tleft)
'WriteToATextFile Str(start)
'WriteToATextFile Str(Len(text))
'start = Len(text) - tleft
text = left(text, start)
'ab#bd.com one two
tright = InStr(text, " ") '9
email = left(text, tright)
WriteToATextFile email
text = right(text, Len(text) - Len(email))
GetEmail txt
Loop
End Sub

Answer 1

What about using a regex (Regular Expression)?
Something like:
Public Function ReplaceAT(ByVal sInput as String)
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "( at |'at'|<at>)"
End With
ReplaceAT = RegEx.Replace(sInput, "#")
Set RegEx = Nothing
End Function
Just replace the regexp with every cases you might get.
See http://www.regular-expressions.info/ for more tips and infos.

Answer 2

I've taken a crack at this to extract emails such as this sample below which will take out the three email addresses in yellow in the sample message below to a csv file
Any valids emails are written to a csv file Set objTF = objFSO.createtextfile("c:\myemail.csv")
This code scans all emails in a folder called temp under Inbox I cut out your recursive portion of testing and simplicity
There are four string manipulations
This line converts any non printing blank spaces to normal spaces strMsgBody = Replace(strMsgBody, Chr(160), Chr(32) (unlikely but it happened in my testing)
Regex1 converts any " at " or "at" etc into "#" "(\s+at\s+|'at'|<at>|\*at\*|at)"
Regex2 converts any " dot " or "dot" etc into "." "(\s+dot\s+|'dot'|<dot>|\*dot\*|dot)"
Regex3 converts any of "<" ">" or ":" into "" .Pattern = "[<:>]"
Regex4 extracts any valid email from the emailbody
Any valid emails are written to the csv file using objTF.writeline objRegM
Code below
Public Test()
Dim objOutlook As New Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objFolder As MAPIFolder
Dim strfld As String
Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object
Dim objFSO As Object
Dim oMailItem As MailItem
Dim objTF As Object
Dim strMsgBody As String
Set objRegex = CreateObject("vbscript.regexp")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objTF = objFSO.createtextfile("c:\myemail.csv")
With objRegex
.Global = True
.MultiLine = True
.ignorecase = True
strfld = "temp"
'Get the MAPI reference
Set objNameSpace = objOutlook.GetNamespace("MAPI")
'Pick up the Inbox
Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objFolder = objFolder.Folders(strfld)
For Each oMailItem In objFolder.Items
strMsgBody = oMailItem.Body
strMsgBody = Replace(strMsgBody, Chr(160), Chr(32))
.Pattern = "(\s+at\s+|'at'|<at>|\*at\*|at)"
strMsgBody = .Replace(strMsgBody, "#")
.Pattern = "(\s+dot\s+|'dot'|<dot>|\*dot\*|dot)"
strMsgBody = .Replace(strMsgBody, ".")
.Pattern = "[<:>]"
strMsgBody = .Replace(strMsgBody, vbNullString)
.Pattern = "[\w-\.]{1,}\#([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,3}"
If .Test(strMsgBody) Then
Set objRegMC = .Execute(strMsgBody)
For Each objRegM In objRegMC
objTF.writeline objRegM
Next
End If
Next
End With
objTF.Close
End Sub