郁闷了很久，如何群发？请大虾指教！

总是只能发送1封邮件，哪位好心人帮着调试一下？Dim sSmtpServerIP As String 'SMTP服务器地址
Dim sSmtpServerPort As String 'SMTP服务器端口Dim sInformation As String '从服务器接收响应消息Private Function WaitForResponse(strResponse As String, WaitTime As Integer)
As Boolean
Dim WaitSt As Date
WaitSt = Now()
While InStr(1, sInformation, strResponse, vbTextCompare) < 1
    DoEvents
    If DateDiff("s", WaitSt, Now) > WaitTime Then
       sInformation = ""
       WaitForResponse = False
       Exit Function
    End If
Wend
sInformation = ""
WaitForResponse = True
End Function
Private Sub Wsock_DataArrival(ByVal bytesTotal As Long)
    'On Error Resume Next
    Wsock.GetData sInformation
    'MsgBox (Err.Description)
    txtStatus.Text = sInformation
End Sub
Private Sub Command1_Click()    For i = 1 To 3
'sSmtpServerIP = "192.168.0.11"
'sSmtpServerPort = "25"
        Wsock.Close
        Wsock.RemoteHost = "192.168.0.11"
        Wsock.RemotePort = 25        m_Date = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") &
" " & Format(Time, "hh:mm:ss") & "" & " -0600"        Dim mData As String
        '构造信件标题字段
        mData = "From:" & Chr(32) & "myname" & vbCrLf & _
                "Date:" & Chr(32) & m_Date & vbCrLf & _
                "X-Mailer: CMS期刊发送系统" & vbCrLf & _
                "Mime-Version: 1.0" & vbCrLf & _
                "Content-Type: text/html;  charset=gb2312" & vbCrLf & _
                "To:" & Chr(32) & "[email protected]" & vbCrLf & _
                "Subject:" & Chr(32) & "hahaha" & vbCrLf
        '设置Winsock
        'If Wsock.State <> sckClosed Then Wsock.Close
        Wsock.Close
        '连接SMTP服务器
        Wsock.Connect
        'MsgBox ((Err.Description) & "连接")
        If Not WaitForResponse("220", 10) Then
            txtStatus.Text = "邮件服务器连接不上......"
            'txtSendFail.Text = txtSendFail.Text & oRs("Email") & vbCrLf
            GoTo NextFor
        End If
        '打开对话
        Wsock.SendData "HELO" & " " & Wsock.LocalHostName & vbCrLf
        If Not WaitForResponse("250", 10) Then
            txtStatus.Text = "无法打开邮件发送对话"
            'txtSendFail.Text = txtSendFail.Text & oRs("Email") & vbCrLf
            GoTo NextFor
        End If
        '发送发送方地址
        Wsock.SendData "MAIL FROM:<" & "[email protected]" & ">" & vbCrLf
        If Not WaitForResponse("250", 10) Then
            txtStatus.Text = "无法发送发送方地址"
            'txtSendFail.Text = txtSendFail.Text & oRs("Email") & vbCrLf
            GoTo NextFor
        End If
        '发送接收方地址
        Wsock.SendData "RCPT TO:<" & "[email protected]" & ">" & vbCrLf
        If Not WaitForResponse("250", 10) Then
            txtStatus.Text = "无法发送接收方地址"
            'txtSendFail.Text = txtSendFail.Text & oRs("Email") & vbCrLf
            GoTo NextFor
        End If
        '发送消息体
        Wsock.SendData "DATA" & vbCrLf
        If Not WaitForResponse("354", 10) Then
            txtStatus.Text = "无法发送消息体"
            'txtSendFail.Text = txtSendFail.Text & oRs("Email") & vbCrLf
            GoTo NextFor
        End If
        Wsock.SendData mData & vbCrLf
        Wsock.SendData "Content" & vbCrLf
        Wsock.SendData "." & vbCrLf
        If Not WaitForResponse("250", 20) Then
            txtStatus.Text = "消息体发送不成功"
            'txtSendFail.Text = txtSendFail.Text & oRs("Email") & vbCrLf
            GoTo NextFor
        End If
        '结束邮件发送对话
        Wsock.SendData "QUIT" & vbCrLf
        If Not WaitForResponse("221", 10) Then
            GoTo NextFor
        End If
        txtStatus.Text = "[email protected]" & " 邮件发送成功!"
        txtSendSucc.Text = txtSendSucc.Text & "[email protected]" & vbCrLf
        'Wsock.Close
NextFor:
     Wsock.Close
    Next
txtStatus.Text = "发送完毕!"
End Sub