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