1,502
社区成员
发帖
与我相关
我的任务
分享请高手帮帮忙吧!很着急的很诚心的请教您!
我就想编个可以发邮件带附件的小程序(用163的邮箱就行),上网搜了好多例子,都用不了,在论坛里提了问题,大家都没有什么办法?高手老师们,请你们帮我下好吗?我真的很着急, 我刚学vb,又不太明白,到底怎么实现呢
...全文
请发表友善的回复…
发表回复
僵哥 2008-06-29
- 打赏
- 举报
Sub SendMail(strFrom As String, strTo As String, strSubject As String, strMsg As String, Attach_File_Count As Integer)
dsSock.Close
dsSock.Connect txtSMTPServer, txtSMTPPort
Waiting
dsSock.SendData "EHLO" & strFrom & vbCrLf
Waiting
If chkSMTP.Value = Checked Then
dsSock.SendData "AUTH LOGIN" & vbCrLf
Waiting
MsgBox Base64Encode(txtUser) & Base64Encode(txtPwd)
dsSock.SendData Base64Encode(txtUser) & vbCrLf
Waiting
dsSock.SendData Base64Encode(txtPwd) & vbCrLf
Waiting
End If
dsSock.SendData "MAIL FROM:<" & strFrom & ">" & vbCrLf
Waiting
dsSock.SendData "RCPT TO:<" & strTo & ">" & vbCrLf
Waiting
dsSock.SendData "DATA" & vbCrLf
Waiting
dsSock.SendData "DATA:" & Format$(Now, "dd mmm yy ttttt") & vbCrLf
dsSock.SendData "FROM:" & strFrom & vbCrLf
dsSock.SendData "TO:" & strTo & vbCrLf
dsSock.SendData "SUBJECT:" & strSubject & vbCrLf
dsSock.SendData "MIME-Version: 1.0" & vbCrLf
dsSock.SendData "Content-Type: multipart/mixed;" & vbCrLf
dsSock.SendData " boundary=""----=_NextPart_000_000A_01C26646.7D0E7AC0""" & vbCrLf
dsSock.SendData "X-Priority: 3" & vbCrLf
dsSock.SendData "X-MSMail-Priority: Normal" & vbCrLf
dsSock.SendData "X-Mailer: My E_MAIL Sender V1.0" & vbCrLf
dsSock.SendData "X-Mime: My E_MAIL Sender V1.0" & vbCrLf & vbCrLf
dsSock.SendData "This is a multi-part message in MIME format." & vbCrLf & vbCrLf
dsSock.SendData "------=_NextPart_000_000A_01C26646.7D0E7AC0" & vbCrLf
dsSock.SendData "Content-Type: multipart/alternative;" & vbCrLf
dsSock.SendData " boundary=""----=_NextPart_001_000B_01C26646.7D0E7AC0""" & vbCrLf & vbCrLf & vbCrLf
dsSock.SendData "------=_NextPart_001_000B_01C26646.7D0E7AC0" & vbCrLf
dsSock.SendData "Content-Type: text/plain;" & vbCrLf
dsSock.SendData " charset=""gb2312""" & vbCrLf
dsSock.SendData "Content-Transfer-Encoding: base64" & vbCrLf & vbCrLf
dsSock.SendData EncodeBase64(strMsg) & vbCrLf & vbCrLf
dsSock.SendData "------=_NextPart_001_000B_01C26646.7D0E7AC0" & vbCrLf
dsSock.SendData "Content-Type: text/html;" & vbCrLf
dsSock.SendData " charset=""gb2312""" & vbCrLf
dsSock.SendData "Content-Transfer-Encoding: base64" & vbCrLf & vbCrLf
dsSock.SendData EncodeBase64("<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">" & vbCrLf & _
"<HTML><HEAD>" & vbCrLf & _
"<META http-equiv=Content-Type content=""text/html; charset=gb2312"">" & vbCrLf & _
"<META content=""MSHTML 6.00.2600.0"" name=GENERATOR>" & vbCrLf & _
"<STYLE></STYLE>" & vbCrLf & _
"</HEAD>" & vbCrLf & _
"<BODY bgColor=#ffffff>" & vbCrLf & _
"<DIV><FONT size=2><PRE>" & strMsg & "</PRE></FONT></DIV></BODY></HTML>")
dsSock.SendData vbCrLf & "------=_NextPart_001_000B_01C26646.7D0E7AC0--" & vbCrLf
'这里可以对文件内部（不是文件名）进行编码一一发送
If Attach_File_Count > 0 Then
For i = 1 To Attach_File_Count
dsSock.SendData vbCrLf & "------=_NextPart_000_000A_01C26646.7D0E7AC0" & vbCrLf & _
"Content-Type: application/octet-stream;" & vbCrLf & _
" name=""" & GetFileName(i) & """" & vbCrLf & _
"Content-Transfer-Encoding: base64" & vbCrLf & _
"Content-Disposition: attachment;" & vbCrLf & _
" filename=""" & GetFileName(i) & """" & vbCrLf & vbCrLf
dsSock.SendData Base64Encodefile(GetFileName(i)) '这里编码的是文件的内容而不是文件名
dsSock.SendData vbCrLf
Next i
dsSock.SendData vbCrLf & "------=_NextPart_000_000A_01C26646.7D0E7AC0--" & vbCrLf
End If
dsSock.SendData vbCrLf & "." & vbCrLf
Waiting
dsSock.Close
MsgBox "信件发送完毕！"
End Sub
