vb自动接收邮件中的附件，并下载到本地硬盘中

Question

RT
我找了很久  
完全不知道怎么做
希望哪个高手指点指点
如果有现场的源码就更好了
如果没有源码也希望有些思路上的指点
我没有做过 
小弟在这先谢谢啦

Answer 1

附件包含在邮件里，使用POP3或IMAP4下载邮件，然后再分离附件。

Answer 2

分离很简单啊，先根据邮件头中Content-Type字段定义的邮件体分隔符分拆出邮件正文（一般有两部分，纯文本和HTML）、邮件内嵌资源（如图片、音乐等，这部分中可选的，根据邮件头的Content-Type字段判断）和邮件附件三节内容，然后再根据附件节的节头（与邮件头一样）中Content-Transfer-Encoding字段定义的编码方式进行解码就行了。

Answer 3

额   4楼的方法太犀利，这种貌似我不会额
Sub Savetheattachment()
    Dim olApp As New Outlook.Application
    Dim nmsName As Outlook.NameSpace
    Dim fldFolder As Outlook.MAPIFolder
    Dim vItem As Object
    
    Set nmsName = olApp.GetNamespace("MAPI")    
Set fldFolder = nmsName.GetDefaultFolder(olFolderInbox)
    If fldFolder.UnReadItemCount > 0 Then
        For Each vItem In fldFolder.Items
           If vItem.UnRead = True Then
           '-----保存附件-------
           For Each att In vItem.Attachments
               att.SaveAsFile "C:\" & att.FileName
     
           Next
           '------保存附件--------
           vItem.UnRead = False
           End If
        Next
    End If
    Set fldFolder = Nothing
    Set nmsName = Nothing
End Sub
红色部分说我控件没有被创建，不知道怎么回事

Answer 4

先在工程引用jmail4.0 如果没这个控件网上搜个
Dim jmail
Dim pop3 As New jmail.pop3
Dim mailMessage As New jmail.message
Dim msg As New jmail.Messages
Dim atts As jmail.Attachments
Dim att As jmail.Attachment
dim m,n as integer
Set jmail = CreateObject("JMAIL.Message")
pop3.Connect "[email protected]", "123456", "pop3.163.com"
pop3.DownloadMessages
     Set att = New jmail.Attachment
    If pop3.Count > 0 Then
        For m = 1 To pop3.Count
          Set atts = pop3.Messages.Item(m).Attachments
          mailMessage.Charset = "GB2312"
          mailMessage.Encoding = "Base64"
          mailMessage.ISOEncodeHeaders = False
               Dim strAttName As String
               n = 0
               strAttName = ""
                   For n = 0 To atts.Count - 1                  '附件
                    If n <> 0 Then strAttName = strAttName & ","
                    Set att = atts(n)
                    strAttName = strAttName & att.Name
                    If Dir(App.Path & "\rar\" & strAttName) = "" Then '判断文件是否存在，如果存在就删除后保存
                    att.SaveToFile (App.Path & "\rar\" & strAttName)
                    Else
                    Kill App.Path & "\rar\" & strAttName
                    MsgBox "文件存在"
                    att.SaveToFile (App.Path & "\rar\" & strAttName)
                    End If
           Next n
        Next m
    Else
    MsgBox "没有邮件"
    End If