How to paste email addresses from clipboard into Outlook “To” field?

Question

Trying to setup VBA code that will take a selection of Excel cells which contain email addresses (with a semi-colon at the end of each address to allow for multiple emails when pasted) and insert those into the "To" field in an new Outlook email. When I execute the below code, it only inserts the email addresses into the Body of the Outlook email, not the "To" field. Is there a way to fix this or will I need to approach this in a completely different fashion?

Here is my code:

Sub Test2()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Subj As String
    Dim oiInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object

    'Copy the email addresses to the clipboard
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    'Create Outlook object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    'Trying to add the email address to the "To" field in the email
    With OutMail
        .Display
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        .To = oRng.Paste

        'This will resolve all the addresses in the email to ensure they exist in your contacts, otherwise pops up error
        If Not .Recipients.ResolveAll Then
            For Each Recipient In .Recipients
                If Not Recipient.Resolved Then
                    MsgBox Recipient.Name & " could not be resolved"
                End If
            Next
        End If
    End With

    On Error GoTo 0

    Set OutApp = Nothing
    Set OutMail = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
End Sub

Answer 1

Try creating a string of recipients instead - you can't paste a range to the .To like that.

Sub Test2()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Subj As String
    Dim oiInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object

    Dim lastrow As Long, i As Long
    Dim recipstring As String

    lastrow = Cells(Rows.Count, 2).End(xlUp).Row

    For i = 2 To lastrow
        If i = 2 Then
            recipstring = Range("B" & i).Value
        Else
            recipstring = recipstring & ";" & Range("B" & i).Value
        End If
    Next i

    'Create Outlook object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    'Trying to add the email address to the "To" field in the email
    With OutMail
        .Display
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        .to = recipstring

        'This will resolve all the addresses in the email to ensure they exist in your contacts, otherwise pops up error
        If Not .Recipients.ResolveAll Then
            For Each Recipient In .Recipients
                If Not Recipient.Resolved Then
                    MsgBox Recipient.Name & " could not be resolved"
                End If
            Next
        End If
    End With

    On Error GoTo 0

    Set OutApp = Nothing
    Set OutMail = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
End Sub