VBA验证列是否包含电子邮件

Question

我不太习惯用 VBA 编程。我的目标是制作一个可以传递给我的同事的脚本，因为他们有很长的 Excel 文件，其中的一列包含多个单词，包括一个电子邮件地址。例如：公司用户 user@company.com

我的正则表达式无法传递所有数据，似乎无法过滤掉任何内容。

Function isEmail(ByVal data As String)

Dim mailReg As Object
Set mailReg = CreateObject("VBScript.RegExp")

Dim regpattern As String
regpattern = "^[_a-z0-9-]+(.[a-z0-9-]+)@[a-z0-9-]+(.[a-z0-9-]+)*(.[a-z]{2,4})$" 'Expression ok

Dim arr1() As String
Dim element As Variant
Dim strInput As String

arr1() = Split(data, " ")

For Each element In arr1

    If regpattern <> "" Then
    strInput = element

    With mailReg
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = regpattern
    End With

MsgBox (strInput)

End If
Next element 
End Function

我也试过用

For Each element In arr1

If element Like regpattern Then
MsgBox (element)

End If
Next element 
End Function

但随后 MsgBox 中什么也没有出现..

Answer 1

使用以下代码打印出邮件地址： 感谢braX！

Function isEmail(ByVal data As String)

Dim mailReg As Object
Set mailReg = CreateObject("VBScript.RegExp")

Dim regpattern As String
regpattern = "^[_a-z0-9-]+(.[a-z0-9-]+)@[a-z0-9-]+(.[a-z0-9-]+)*(.[a-z]{2,4})$" 'Expression ok

Dim arr1() As String
Dim element As Variant
Dim strInput As String

arr1() = Split(data, " ")

For Each element In arr1

    strInput = element
    mailReg.IgnoreCase = True
    mailReg.Global = True
    mailReg.Pattern = regpattern

    If mailReg.Test(strInput) = True Then

    MsgBox (strInput)
    End If
Next element
End Function

Answer 2

Option Explicit

Const MODULE_NAME As String = "modMail"

    '' Validate email address
    Public Function ValidateEmailAddress(ByVal strEmailAddress As String) As Boolean
        On Error GoTo Catch

        Dim objRegExp As New RegExp
        Dim blnIsValidEmail As Boolean

        objRegExp.IgnoreCase = True
        objRegExp.Global = True
        objRegExp.Pattern = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$"

        blnIsValidEmail = objRegExp.Test(strEmailAddress)
        ValidateEmailAddress = blnIsValidEmail

        Exit Function

    Catch:
        ValidateEmailAddress = False
        MsgBox "Module: " & MODULE_NAME & " - ValidateEmailAddress function" & vbCrLf & vbCrLf _
            & "Error#:  " & Err.Number & vbCrLf & vbCrLf & Err.Description
    End Function