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

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

Answer 2

得到它，用以下代码打印出邮件地址：感谢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