200求教,首先谢谢大哥大姐之前的帮助,小弟现在还有个问题,暴风雨给我了一段代码,可以实现通过公司的SMTP 发Mail,请问如何解决可以同时给多人发Mail
比如 收件人为 [email protected],[email protected]
如何使这两个人都收到邮件呢?在暴风雨的代码中发送邮件如下:
'發送接收方地址
Wsock.SendData "RCPT TO:" & " " & strToMail & vbCrLf
If Not WaitForResponse("250", 10) Then
    txtMsg.Text = txtMsg.Text & "無法發送接收方地址" & vbCrLf
    Exit Sub
End If其中 strToMail  存放的就是收件人的地址,如[email protected] 目前单个地址可以发送
现在我想发给多个人,邮件地址用逗号隔开,请问如何修改,谢谢
********************************************************************************
源代码如下(全部)Option Explicit
Public ServerIp As String 'SMTP服務器地址
Public ServerPort As Long 'SMTP服務器端口Dim strSendName As String '發送人姓名
Dim strReceiveName As String '接收人姓名
Dim strFromMail As String '發送人地址
Dim strToMail As String '接收人地址
Dim m_Date As String '發送日期
Dim strSubject As String '主題
Dim strContent As String '正文
Dim Information As String '從服務器接收響應消息Private Sub cmdSend_Click()
'設置Winsock
Wsock.Close
Wsock.RemoteHost = ServerIp 'SMTP服務器地址
Wsock.RemotePort = ServerPort 'SMTP服務器端口
strSendName = txtSName.Text
strReceiveName = txtRName.Text
strFromMail = txtFrom.Text
strToMail = txtTo.Text
'm_Date = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
 m_Date = Now
strSubject = txtSubject.TextstrContent = txtContent.Text 
' strContent = StrConv(strContent, vbFromUnicode, &H404)
Dim mData As String
'构造信件標題字段
mData = "From:" & Chr(32) & strSendName & vbCrLf & _
        "Date:" & Chr(32) & m_Date & vbCrLf & _
        "To:" & Chr(32) & strReceiveName & vbCrLf & _
        "Subject:" & Chr(32) & strSubject & vbCrLf
Wsock.Close
'連接SMTP服務器
Wsock.Connect
If Not WaitForResponse("220", 10) Then
    txtMsg.Text = "郵件服務器連接不上......"
    Exit Sub
End If
'打開對話
Wsock.SendData "HELO" & " " & Wsock.LocalHostName & vbCrLf  '
If Not WaitForResponse("250", 10) Then
    txtMsg.Text = txtMsg.Text & "無法打開郵件發送對話" & vbCrLf
    Exit Sub
End If
'發送發送方地址
Wsock.SendData "MAIL FROM:" & " " & strFromMail & vbCrLf
If Not WaitForResponse("250", 10) Then
    txtMsg.Text = txtMsg.Text & "無法發送發送方地址" & vbCrLf
    Exit Sub
End If
'發送接收方地址
Wsock.SendData "RCPT TO:" & " " & strToMail & vbCrLf
If Not WaitForResponse("250", 10) Then
    txtMsg.Text = txtMsg.Text & "無法發送接收方地址" & vbCrLf
    Exit Sub
End If'發送消息體
Wsock.SendData "DATA" & vbCrLf
If Not WaitForResponse("354", 10) Then
    txtMsg.Text = txtMsg.Text & "無法發送消息體" & vbCrLf
    Exit Sub
    
End If
Wsock.SendData mData & vbCrLf
Wsock.SendData strContent & vbCrLf
Wsock.SendData "." & vbCrLf
If Not WaitForResponse("250", 20) Then
    txtMsg.Text = txtMsg.Text & "消息體發送不成功" & vbCrLf
    Exit Sub
End If
'結束郵件發送對話
Wsock.SendData "QUIT" & vbCrLf
If Not WaitForResponse("221", 10) Then
    Exit Sub
End If
Wsock.Close
txtMsg.Text = txtMsg.Text & "郵件發送成功"
txtMsg.Text = txtMsg.Text & mData & vbCrLf & strContent & vbCrLf
End Sub'該按扭事件過程用于設置smtp服務
Private Sub cmdSetUp_Click()
frmSetup.Show
End Sub'程序加載時讀出上次的設置
Private Sub Form_Load()
ServerIp = GetSetting("email", "smtpserver", "serverip", "")
ServerPort = GetSetting("email", "smtpserver", "serverport", 25)
Wsock.Protocol = sckTCPProtocol  '協議只能為TCP/IP 協議
End Sub'程序退出時保存設置
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
SaveSetting "email", "smtpserver", "serverip", ServerIp
SaveSetting "email", "smtpserver", "serverport", ServerPort
End Sub'接收服務器的響應消息
Private Sub Wsock_DataArrival(ByVal bytesTotal As Long)
Wsock.GetData Information
txtMsg.Text = txtMsg.Text & Information & vbCrLf
End Sub'該函數用于等待服務器響應碼
Private Function WaitForResponse(strResponse As String, WaitTime As Integer) As Boolean
Dim WaitSt As Date
WaitSt = Now()
While InStr(1, Information, strResponse, vbTextCompare) < 1  'vbTextCompare =1,從第一個開始比較,大小寫相同
    DoEvents  '將程式碼執行權讓給作業系統
    If DateDiff("s", WaitSt, Now) > WaitTime Then  '計算相差天數
       Information = ""
       WaitForResponse = False
       Exit Function
    End If
Wend
Information = ""
WaitForResponse = True
End Function
SMTP 设置Option ExplicitPrivate Sub cmdQuit_Click(Index As Integer)
If Index = 0 Then
    smtp.ServerIp = txtIp.Text  'SMTP服務器地址
    smtp.ServerPort = CLng(txtPort.Text) ''SMTP服務器端口
    
    
End If
Unload Me
End SubPrivate Sub Form_Load()
txtIp.Text = smtp.ServerIp
txtPort.Text = smtp.ServerPort
End Sub