急！急！急！用VB 发指定文件到指定邮箱！

下面代码在WIN2000和VB6测试通过， 自己分析吧！！！

If chkAttachment.Value And txtAttachment.Text = "" Then
MsgBox "请选择输入附件的完整的路径和文件名称。", , Me.Caption
Exit Sub
End If
lblInfo.Caption = "正在发送邮件, 请等待 ... ..."
Call SendHtmlMail

Private Sub SendHtmlMail()
On Error GoTo ErrorHandle

Dim i As Integer
If ListView1.ListItems.Count < 1 Then 'ListView1中是收件人名、邮箱地址及其他
Exit Sub
End If

Dim objSession As CDONTS.Session'安装邮件服务后，才可用

' error handling ...
Set objSession = CreateObject("CDONTS.Session")
If Not objSession Is Nothing Then
Call objSession.LogonSMTP(txtName.Text, txtSend.Text)
End If

Dim objMail As New CDONTS.NewMail 'Object
Set objMail = CreateObject("CDONTS.NewMail")

Timer1.Enabled = True
i = 1
Do
'发邮件人邮箱地址
objMail.From = txtSend.Text '
'邮件主题
objMail.Subject = txtSubject.Text
If chkAttachment.Value And txtAttachment.Text <> "" Then
' Dim i As Integer
Dim fileName As String
objMail.AttachFile txtAttachment.Text, AttachmentFile
End If

If chkMailFormat.Value Then
'邮件格式为超文本
objMail.MailFormat = 0
objMail.BodyFormat = 0
Else
'邮件格式为纯文本形式
objMail.MailFormat = 1
objMail.BodyFormat = 1
End If
'邮件内容
objMail.Body = RichTextBox1.Text '"This is a sample message."

Set itmX = ListView1.ListItems(i)
'收邮件人邮箱地址
objMail.To = itmX.ListSubItems(3).Text
objMail.Send
Call DelayTime(0.5)
itmX.SmallIcon = 2 ' 成功
itmX.SubItems(4) = "发送成功"
MoveNext:
i = i + 1
Loop Until i > ListView1.ListItems.Count

Set objMail = Nothing
Timer1.Enabled = False

MsgBox "发送邮件完成 ！", vbOKOnly, Me.Caption

Exit Sub
ErrorHandle:
On Error Resume Next
Select Case Err.Number
Case 0
Call DelayTime(1)
Resume Next
Case 32014
itmX.SmallIcon = 3 '失败
itmX.SubItems(4) = "失败，收件人地址可能有错."
Resume Next
Case 32002
MsgBox "发送邮件附件出错，原因：" & Err.Number & " " & Err.Description, , Me.Caption
cmdSend.Caption = "发 送"
Frame1.Visible = True
Set objMail = Nothing
Timer1.Enabled = False
Case 32012
MsgBox "打开附件文件时出错，原因：" & Err.Number & " " & Err.Description, , Me.Caption
cmdSend.Caption = "发 送"
Set objMail = Nothing
Frame1.Visible = True
Timer1.Enabled = False
Case Else
MsgBox "发送邮件出错，原因：" & Err.Number & " " & Err.Description, , Me.Caption
Set objMail = Nothing
Timer1.Enabled = False
End Select
End Sub
试试 成功了再说

呵呵 想笑 该不会是发送MsgEx.db这个文件吧???
曾试过写过一个发这个文件上FTP的程序 可是没成功~~~~~~郁闷
纯粹路过................