Separate email addresses and display them in a message box

[Pookiemeister]

I have inputbox that asks the user, how many people they want to send an email to? Depending on the number of people, it will loop a userform that many times allowing the user to enter in the different email addresses. The value will be stored into a string separated by a semicolon.

Questions:
1. Is there a way to count the number of emails entered?
2. Then display those email addresses in a message box (for test purposes). Each email on its own line. Using the vbnewline.
3. If the user wanted to add a new email address, it looks at the values in the string and if the person they want to enter is already included, display a message that states something like user already entered.

I thought about storing this an array, but I've never done this before. Is there a better method to do what I am wanting? Thanks

 

[AlphaFrog]

Sub Test()
    Dim strEmails As String
    Dim arrEmails As Variant
    Dim strNewEmail As String
    
    strEmails = "Bob@MrExcel.com;Jim@MrExcel.com;Tom@MrExcel.com"
    arrEmails = Split(strEmails, ";") 'Array of emails. Starts at 0 and not 1
    
    Do While MsgBox("There are " & UBound(arrEmails) + 1 & " email addresses." & vbLf & vbLf & _
            Join(arrEmails, vbNewLine) & vbLf & vbLf & "Would you like to add another?", _
            vbInformation + vbYesNo, "Emails") = vbYes
            
        strNewEmail = Application.InputBox("Enter a new email address", "New Email", Type:=2)
        If strNewEmail <> "" Then
            If InStr(LCase(strEmails), LCase(strNewEmail)) = 0 Then 'test if emal exists
                ReDim Preserve arrEmails(0 To UBound(arrEmails) + 1)
                arrEmails(UBound(arrEmails)) = strNewEmail
            Else
                MsgBox "This is a diplicate email." & vbLf & strNewEmail, vbExclamation, "Duplicate Email"
            End If
            strNewEmail = ""
            strEmails = Join(arrEmails, ";")
        End If
    Loop
    
    MsgBox strEmails, , "All Email Addresses with ; delimiter"
    
End Sub

 

[Pookiemeister]

Thank you for help but how can I save it. Every time I open this program; it states that there are no email addresses. Is there not a way to save the email addresses in between quotes? I modified this subroutine, but I still can't save it so when I reopen this program, I don't get a message stating "There are 0 email addresses",
So when the program starts, the string variable "EmailTo" is equal to an empty string, then when the users adds email addresses, it places those emails in between quotes separated by the ";" delimiter.
"EmailTo" is dimmed string and is public variable

Sub Email()
    Dim strEmails As String, strNewEmail As String
    Dim arrEmails As Variant
    Dim intEmailAns As Integer
   
    strEmails = EmailTo '"Bob@MrExcel.com;Jim@MrExcel.com;Tom@MrExcel.com"
    arrEmails = Split(strEmails, ";") 'Array of emails. Starts at 0 and not 1
   
   
    If strEmails = "" Then
        MsgBox "There doesn't appear to be any emails listed. You will now be prompted to enter them in.", vbInformation + vbOKOnly, "No Emails Listed"
        GoTo recipients
    End If
    Debug.Print strEmails & vbLf & arrEmails
   
    Do While MsgBox("There is/are " & WorksheetFunction.CountA(arrEmails) & " email address(es)." & vbLf & vbLf & _
            Join(arrEmails, vbNewLine) & vbLf & vbLf & "Would you like to add another?", _
            vbInformation + vbYesNo, "Emails") = vbYes
            GoTo recipients
    Loop
   
recipients:
    strNewEmail = Application.InputBox("Enter a new email address", "New Email", Type:=2)
        If strNewEmail <> "" Then
            If InStr(LCase(strEmails), LCase(strNewEmail)) = 0 Then 'test if email exists
                ReDim Preserve arrEmails(0 To UBound(arrEmails) + 1)
                arrEmails(UBound(arrEmails)) = strNewEmail
            Else
                MsgBox "This is a duplicate email." & vbLf & strNewEmail, vbExclamation, "Duplicate Email"
            End If
            strNewEmail = ""
            strEmails = Join(arrEmails, ";")
        End If
   
    intEmailAns = MsgBox("Would you like to add another E-Mail address?", vbYesNo)
   
    Select Case intEmailAns
        Case 6
            GoTo recipients
        Case 7
            EmailTo = strEmails
            MsgBox EmailTo, , "All Email Addresses with ; delimiter"
    End Select
   
    ThisWorkbook.Save
     
End Sub