0

I am trying to create a macro that will copy the valid email addresses in a column to the clipboard on button click, ignoring any invalid ones. I am completely new to VBA and as such I am having some difficulties. I've looked all over the internet and stack exchange and this is what I have been able to come up with so far:

Private Sub CommandButton1_Click()

Dim clipboard As MSForms.DataObject
Dim Emails As String
Set r = Intersect(Range("B1").EntireColumn, ActiveSheet.UsedRange)

For Each i In r
    If Trim(i) Like "?*@[!.]*.[!.]*" Then
        If Not i Like "*@*@*" Then
            Emails = Emails & i
        End If
    End If
Next i

clipboard.SetText Emails
clipboard.PutInClipboard

End Sub

This code is supposed to evaluate each cell in a column to determine if the email address is valid, and if it is valid, append the email address to the String Emails. Once finished, the String will be copied to the clipboard so that it can be pasted in the "To" line of an email client (ie, Outlook). I've also considered other solutions, such as adding all valid email addresses to an array, but it seemed more complicated to copy an array to the clipboard. Either way if there is a more elegant solution, I'm all for it. Any pointers are appreciated!

Saku
  • 35
  • 7
  • 1
    That looks like regex validation with that `LIKE` which isn't going to work with `LIKE`. You'll need to add the [regex library](https://stackoverflow.com/questions/22542834/how-to-use-regular-expressions-regex-in-microsoft-excel-both-in-cell-and-loops) to use that type of logic. – JNevill Oct 01 '18 at 16:20
  • 2
    If using regex please include some expected pass/fail cases. – QHarr Oct 01 '18 at 16:23
  • 2
    Yikes, validating emails [can get really scary](https://stackoverflow.com/a/201378/2727437), OP. You watch yourself out there – Marcucciboy2 Oct 01 '18 at 16:25
  • Oh, I did not know I was using regex :| I was using information from this site: http://learnexcelmacro.com/wp/2013/09/email-id-syntax-validation/ Looks like I'll have to find a different way because it wasn't my intention to use regex. – Saku Oct 01 '18 at 16:26
  • You're not currently, but I think it's generally a better idea not to reinvent the wheel once you see how complicated it can really be. Don't get me wrong, if it's just a small little program for yourself or a smallish group, you can still use `LIKE` – Marcucciboy2 Oct 01 '18 at 16:27
  • Try this regex: "/^[_\.0-9a-zA-Z-]+@([0-9a-zA-Z][0-9a-zA-Z-]+\.)+[a-zA-Z]{2,6}$/i" –  Oct 01 '18 at 16:28
  • 2
    Once you've identified your "email-address-looking-string", and it's time to append it to your `To:` line, you'll want to change this `Emails = Emails & i` to this `Emails = Emails & "; " & i` - Outlook uses the `;` character as its default email address separator and you'll need to put that in. Otherwise your string will end up looking like `foo@bar.combaz@biff.com` when you want `foo@bar.com; baz@biff.com` – FreeMan Oct 01 '18 at 16:59
  • 2
    @Marcucciboy2 - There's also [this page too](https://davidcel.is/posts/stop-validating-email-addresses-with-regex/) which warns against using Regex to validate emails. – BruceWayne Oct 01 '18 at 17:12
  • 1
    @BruceWayne that's actually the exact article I was thinking of when I included my warning haha. Thanks for dropping it in – Marcucciboy2 Oct 01 '18 at 19:38

1 Answers1

2

Okay, after some further research and thanks to some of the responses here, I've managed to come up with a working program. Using regex because it is the simplest solution for what I am trying to do. This is just for a few people in my company to make their lives a bit easier so it should be fine. The regex pattern is not foolproof, but works well enough for our purposes. I will probably continue to prune it. Anyway, here is the working code:

Private Sub CommandButton1_Click()

Dim Emails As String
Set r = Intersect(Range("B1").EntireColumn, ActiveSheet.UsedRange)

With CreateObject("VBScript.RegExp")
        .Pattern = "^[\w-\.]+@([\w-]+\.)+[A-Za-z]{2,3}$"
        For Each cell In r
            If .Test(cell.Value) Then
                Emails = Emails & cell.Value & "; "
                ClipBoard_SetData (Emails)
                cell.Interior.ColorIndex = 0
            Else
                cell.Interior.ColorIndex = 22
            End If
        Next cell
    End With

    MsgBox "Emails copied!"

End Sub

I also used an API (found here) for copying the string to the clipboard because MSForms was not working. But that's it!

Note: I would like to upvote some of the comments but I am unable to do so because I do not have enough reputation yet. But thank you all for your advice!

Saku
  • 35
  • 7