Including separator in VBA code to extract email addresses from a string

K_TF_2015 

To modify the VBA code so that the extracted email addresses are separated by a semi-colon (;) followed by a space, you can make the following changes:

Replace this line of code:

Vba code:

outStr = outStr & Chr(10) & getStr

With this line of code:

Vba code:

outStr = outStr & "; " & getStr

This will append the extracted email address to the outStr variable, separated by a semi-colon and a space.

The updated VBA code will look like this (untested):

Sub ExtractEmail()
    ' Update 20130829
    Dim WorkRng As Range
    Dim arr As Variant
    Dim CharList As String

    On Error Resume Next
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    arr = WorkRng.Value
    CheckStr = "[A-Za-z0-9._-]"

    For i = 1 To UBound(arr, 1)
        For j = 1 To UBound(arr, 2)
            extractStr = arr(i, j)
            outStr = ""
            Index = 1

            Do While True
                Index1 = VBA.InStr(Index, extractStr, "@")

                getStr = ""

                If Index1 > 0 Then
                    For p = Index1 - 1 To 1 Step -1
                        If Mid(extractStr, p, 1) Like CheckStr Then
                            getStr = Mid(extractStr, p, 1) & getStr
                        Else
                            Exit For
                        End If
                    Next

                    getStr = getStr & "@"

                    For p = Index1 + 1 To Len(extractStr)
                        If Mid(extractStr, p, 1) Like CheckStr Then
                            getStr = getStr & "; "
                        Else
                            Exit For
                        End If
                    Next

                    Index = Index1 + 1

                    If outStr = "" Then
                        outStr = getStr
                    Else
                        outStr = outStr & "; " & getStr
                    End If
                Else
                    Exit Do
                End If
            Loop

            arr(i, j) = outStr
        Next
    Next

    WorkRng.Value = arr
End Sub

With this modification, the email addresses will be extracted and separated by semi-colons in the outStr variable, and then the modified values will be written back to the cells in the specified range (WorkRng).

My answers are voluntary and without guarantee!

Hope this will help you.