如何將剪貼板中的電子郵件地址粘貼到Outlook“收件人”字段中？

Question

嘗試設置將選擇包含電子郵件地址的Excel單元格的VBA代碼（每個地址的末尾帶有分號，以便在粘貼時允許多封電子郵件），然后將其插入新Outlook中的“收件人”字段電子郵件。 當我執行以下代碼時，它僅將電子郵件地址插入到Outlook電子郵件的正文中，而不是“收件人”字段中。 有沒有辦法解決這個問題，還是我需要以一種完全不同的方式來解決這個問題？

這是我的代碼：

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

嘗試改為創建一串收件人-您無法將范圍粘貼到.To 。

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