regex - 如何用@ 替换 'at'

Question

我有大约 17,000 封电子邮件，其中包含 11 年前的订单、新闻、联系人等。

通过更改 @，用户的电子邮件地址已被粗制滥造地加密以阻止爬虫和垃圾邮件。至 *@*或 'at' .

我正在尝试创建一个逗号分隔的列表来构建我们的用户数据库。

该代码适用于编写文件和循环文件夹，因为如果我将发件人的电子邮件地址写入我当前使用电子邮件正文的文件，那么它可以正常打印。

问题是，Replace s 没有变化 *at*等到 @ .

首先，为什么不呢？

有没有更好的方法让我整体上做到这一点？

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

使用正则表达式(正则表达式)怎么样？

就像是:

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

只需用您可能获得的每种情况替换正则表达式。
见 http://www.regular-expressions.info/了解更多提示和信息。