100分 VB 如何在程序运行时,将指定的文件通过网络发送到指定的邮箱

Question

VB 如何在程序运行时,将指定的文件通过网络发送到指定的邮箱,循环时间为10分钟(每10分钟发一次)!

Answer 1

http://hi.baidu.com/codefd/blog/item/e8de090f7feb3bcd7acbe17a.html  '你参考一下...

Answer 2

http://hi.baidu.com/codefd/blog/item/e8de090f7feb3bcd7acbe17a.html  '你参考一下...

Answer 3

http://www.cnblogs.com/tongnaifu/archive/2008/10/22/1316600.html
修改一下即可，要先引用CDO

Answer 4

使用第三方邮件客户端等，JMail，调用它的库，剩下的就是一个定时器Timer等，到了一定时间就发送邮件.

Answer 5

Option ExplicitPrivate Sub cmdCommand1_Click()
    SendMail "主题", "正文", ""
End SubSub SendMail(Optional ByVal sSubject As String, _
        Optional ByVal sBody As String, _
        Optional ByVal sFileName As String)
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------    Dim Jmail
    Set Jmail = CreateObject("jmail.Message")
    'If sFileName <> "" Then Jmail.AddAttachment sFileName             '如果如果要发附件，去掉这句的注释    Jmail.Charset = "gb2312"
    Jmail.Silent = False
    Jmail.Priority = 3  '邮件状态,1-5 1为最高
    Jmail.MailServerUserName = "apple"        '你的Email帐号，自己改
    Jmail.MailServerPassWord = "123456"         '你的Email密码，自己改    Jmail.FromName = "邮件"            '发信人姓名，自己改
    Jmail.From = "[email protected]"     '发邮件地址地址，自己改    Jmail.Subject = sSubject                  '主题
    Jmail.AddRecipient "[email protected]"        '收信人地址，自己改
    Jmail.Body = sBody                      '信件正文    Jmail.Send ("smtp.163.com")      'SMTP服务器，如smtp.sohu.com    Set Jmail = Nothing
    MsgBox "OK"    '------------------------------------------------
    Exit Sub
    '----------------
ToExit:
    Select Case Jmail.ErrorCode
    Case 550
        MsgBox "该邮件地址不存在，请更改后再发", , "提示"
    Case 535
        MsgBox "发件人的用户名或密码错误，请改正后再发", , "提示"
    Case Else
        MsgBox Jmail.ErrorMessage, , "提示"
    End Select
End Sub
http://hi.baidu.com/cfans/blog/item/78232edd07d876d18d1029cd.html
这里是个详细的例子，可以下载看看

Answer 6

对了，忘记说，以上使用Jmail发邮件的，发信人的账号密码一定要对。如果想10分钟一次，把SendMail "主题", "正文", ""放在TIMER里就好了。http://hi.baidu.com/cfans/blog/item/78232edd07d876d18d1029cd.html
这个例子里有Jmail下

Answer 7

不可能吧，绝对可用SendMail "主题", "正文", "c:\1.txt"   '这里的附件路径要填才可以发附件
If sFileName <> "" Then Jmail.AddAttachment sFileName             '去掉这句的注释

Answer 8

确实不行,只要引用JMAIL.DLL就行了吗?收不到..........

Answer 9

有可能你的邮箱没开通STMP\pop服务

Answer 10

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End TypeDim MailPassWord, MailUserName As String
Dim SendError As BooleanPrivate Sub Command2_Click()
    Dim i, j, TitleRow, BottomRow, FirstCol, LastCol As Integer
    Dim MailBody, Mailtitle, MailAddress, Name As String
    Dim Address As Boolean       '框选内容有没有邮箱地址
    Mailtitle = Text2    With MSFlexGrid1
        If .Row < .RowSel Then
            TitleRow = .Row
            BottomRow = .RowSel
        ElseIf .Row > .RowSel Then
            TitleRow = .RowSel
            BottomRow = .Row
        Else
            MsgBox "你选择的区域有错", , "提示"
            Exit Sub
        End If        If .Col < .ColSel Then
            FirstCol = .Col
            LastCol = .ColSel
        ElseIf .Col > .ColSel Then
            FirstCol = .ColSel
            LastCol = .Col
        Else
            MsgBox "你选择的区域有错", , "提示"
            Exit Sub
        End If        If Trim(MSFlexGrid1.TextMatrix(TitleRow, FirstCol)) <> "姓名" Then
            MsgBox "框选的内容要包括“姓名、英语、数学、邮箱.....这一行”", , "提示"
            Exit Sub
        End If        If SendError = True Then   '如果邮件发送错误标记，重新设置发件人账号密码
            MailUserName = ""
            MailPassWord = ""
        End If
        
        SendError = False   '重设发件人账号密码后恢复错误标记
        
        Do While MailUserName = "" Or MailPassWord = ""      '获得发件人账号密码
            Call GetMailPassword
        Loop
                For j = TitleRow + 1 To BottomRow
            MailBody = ""
            MailAddress = ""
            For i = FirstCol To LastCol
                Select Case Trim(MSFlexGrid1.TextMatrix(TitleRow, i))
                Case "姓名"
                    MailBody = MailBody + Trim(MSFlexGrid1.TextMatrix(j, i)) + "同学你好，你的成绩为：" + Chr(13) + Chr(10)
                Case "邮箱"
                    Address = True
                    MailAddress = Trim(MSFlexGrid1.TextMatrix(j, i))
                Case Else
                    If Trim(MSFlexGrid1.TextMatrix(TitleRow, i)) <> "" Or Trim(MSFlexGrid1.TextMatrix(j, i)) <> "" Then   '当两样都是空白的话，就是多框选的空白区域
                        MailBody = MailBody + Trim(MSFlexGrid1.TextMatrix(TitleRow, i)) + "：" + Trim(MSFlexGrid1.TextMatrix(j, i)) + Chr(13) + Chr(10)
                    End If
                End Select
            Next
            If MailAddress = "" Then     '当邮件地址是空
                If Trim(MSFlexGrid1.TextMatrix(j, FirstCol)) = "" Then      '当邮件地址是空，且发件人姓名也是空时，认为发送完毕
                    MsgBox "发送完毕，您框选了一些空白区域", , "提示"
                    Command2.Caption = "框选要群发的内容，单击此按钮开始群发"
                    Exit Sub
                End If                If Address = False Then
                    MsgBox "框选内容没有邮箱地址，无法发送，请重新框选", , "提示"
                    Command2.Caption = "框选要群发的内容，单击此按钮开始群发"
                    Exit Sub
                End If
                MsgBox Trim(MSFlexGrid1.TextMatrix(j, FirstCol)) + "同学的邮件地址无法取得，可能是没有填写", , "提示"
            End If
            SendMail Trim(Mailtitle), MailBody, "", MailAddress
            If SendError = True Then
                MsgBox "邮件发送到" + Trim(MSFlexGrid1.TextMatrix(j, FirstCol)) + "同学时出错，" + "请重新发送", , "提示"
                Command2.Caption = "框选要群发的内容，单击此按钮开始群发"
                Exit Sub
            End If
            Command2.Caption = "发送了" & j - TitleRow & "封邮件"
            DoEvents
        Next
    End With
    MsgBox "发送完毕", , "提示"
    Command2.Caption = "框选要群发的内容，单击此按钮开始群发"
End Sub'//自动调整Grid各列列宽为最合适的宽度
Public Sub AdjustColWidth(frmCur As Form, gridCur As Object, Optional bNullRow As Boolean = True, Optional dblIncWidth As Double = 0)
    '--------------------------------------------------------------------
    '功能:
    '                               自动调整Grid各列列宽为最合适的宽度
    '参数:
    '                               [frmCur].........................................当前工作窗体
    '                               [gridCur]........................................当前要调整的Grid
    '--------------------------------------------------------------------
    Dim i, j       As Integer
    Dim dblWidth     As Double    With gridCur
        For i = 0 To .Cols - 1
            dblWidth = 0
            If .ColWidth(i) <> 0 Then
                For j = 0 To .Rows - 1
                    If frmCur.TextWidth(.TextMatrix(j, i)) > dblWidth Then
                        dblWidth = frmCur.TextWidth(.TextMatrix(j, i))
                    End If
                Next
                .ColWidth(i) = dblWidth + dblIncWidth + 100
            End If
        Next
    End With
End SubPublic Sub SendMail(Optional ByVal sSubject As String, _
                    Optional ByVal sBody As String, _
                    Optional ByVal sFileName As String, Optional ByVal MailTo As String)    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------    Dim Jmail
    Dim ErrorTimes As Integer
    ErrorTimes = 0
    Set Jmail = CreateObject("jmail.Message")
    If sFileName <> "" Then Jmail.AddAttachment sFileName             '附件    Jmail.Charset = "gb2312"
    Jmail.Silent = False
    Jmail.Priority = 3  '邮件状态,1-5 1为最高
    Jmail.MailServerUserName = MailUserName         '发件人Email帐号,自己改
    Jmail.MailServerPassWord = MailPassWord        '发件人Email密码,自己改    Jmail.FromName = "西门吹雪"            '发信人姓名,自己改
    Jmail.From = MailUserName + "@qq.com"   '发邮件地址,自己改    Jmail.Subject = sSubject                  '主题
    Jmail.AddRecipient MailTo        '收信人地址
    Jmail.Body = sBody                      '信件正文    Jmail.Send ("smtp.qq.com")      'SMTP服务器，如smtp.sohu.com
    DoEvents    Set Jmail = Nothing
    '------------------------------------------------
    Exit Sub
    '----------------
ToExit:
    ErrorTimes = ErrorTimes + 1
    If ErrorTimes < 3 Then Resume
    Select Case Jmail.ErrorCode
    Case 550
        MsgBox MailTo + "该邮件地址不存在，请更改后再发", , "提示"
    Case 535
        MsgBox "发件人的用户名或密码错误，请改正后再发", , "提示"
    Case Else
        MsgBox Jmail.ErrorMessage, , "提示"
    End Select
    SendError = True
End SubPrivate Sub Form_Load()
    SendError = False
    Command2.Caption = "框选要群发的内容，单击此按钮开始群发"
    MailUserName = ""
    MailPassWord = ""
End Sub