尝试下面的代码，我已经添加了一个Select Case，它具有各种逻辑，具体取决于您打开的Outlook邮件的数量。我已经为代码添加了注解，以使其具有一定的意义。

• 修改代码 *

Private Sub CommandButton15_Click()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim OutInspector As Object
    Dim OutOpenObjCount As Long, i As Long, EmailMsgCount As Long
    
    Dim emailRng As Range, cl As Range
    Dim sTo As String
    
   
    Set emailRng = Worksheets("Emails").Range("G4:G200")
    
    For Each cl In emailRng
        If cl.Value <> "" Then
            sTo = sTo & ";" & cl.Offset(, 1).Value
        End If
    Next
    sTo = Mid(sTo, 2)
                
    ' --- Check if there's an Open Email Message ---
    
    ' check if Outlook already open
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If OutApp Is Nothing Then
        ' create Outlook object before the loop
        Set OutApp = CreateObject("Outlook.Application")
    End If
    
    EmailMsgCount = 0 ' reset count
    
    ' check number of Outlook open objects, include msg, meetings, contacts
    OutOpenObjCount = OutApp.Inspectors.Count
        
    For i = 1 To OutOpenObjCount
        Set OutInspector = OutApp.Inspectors.Item(i)
    
        ' check if type of outlook item is a message
        If OutInspector.CurrentItem.Class = 43 Then ' Numeric value of olMail
            EmailMsgCount = EmailMsgCount + 1 ' increase count of open email messages
            Set OutMail = OutInspector.CurrentItem
        End If
    Next i
    
    ' - Main Logic depending of # of Open Messages in Outlook
    Select Case EmailMsgCount
        Case Is > 1 ' more than 1 open message --> can't determin automaticaal which one to refer to
            MsgBox "You have " & EmailMsgCount & " open email messages in Outlook"
    
        Case 0 ' none open --> create new Message
            ' your original code goes here
            Set OutMail = OutApp.CreateItem(0)                
            With OutMail
               .to = sTo
        
               .Display
            End With
           
        Case 1 ' Use the only 1 message open            
            With OutMail
               .to = .to & ";" & sTo  ' CONCAT new Addresses to existing email addresses
        
               .Display
            End With
                
    End Select
End Sub

字符串