关于access发邮件的一些摘录

时　间:2009-04-02 10:24:01
作　者:摘自网络   ID：54  城市：东营
摘　要: 关于ACCESS发邮件的一些摘录
正　文:

    关于ACCESS发邮件的一些摘录
 

打开outlook，在Visual Basic编辑器中插入一个模块，加入下面这段代码

Sub SendMail()
'
'函数功能： 创建Outlook的MailItem，并发送邮件
'作者：Winak
'时间：2003-7-22

  Dim ItemUsageEmail As Outlook.MailItem
 
  '创建MailItem对象
  Set ItemUsageEmail = Application.CreateItem(olMailItem)
 
  With ItemUsageEmail
        .To = "winak@163.net"      '设置收件人地址       
        .Subject = "Report"     '邮件主题       
        .Body = "This is a example"            '邮件正文       
        .Attachments.Add "e:\Report.doc"       
       
        .Display 显示邮件

       .Send            发送邮件
  
  End With

End Sub

说明：  .display  和   .send   最好只用一种方法，可以用    .Attachments.Add    一次性加入多个附件。
 

将outlook的收件箱里的邮件里的文件导出的代码.
如何将outlook的收件箱里的邮件里的文件导出：
 
  导入程序的关键需要引用一个outlook对象 

  1、导入至excel或access，如下代码为excel里的一个宏：
 
  Sub Exprot_Mail_xl()

  Dim myolapp As New Outlook.Application
 
  Set myNameSpace = myolapp.GetNamespace("MAPI")
  Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
   
  For i = 1 To myfolder.Items.Count  '简单for...next循环，将所有邮件导出，myfolder.Items.Count是收件箱里邮件的数量
   
  Set mymailitem = myfolder.Items(i)
    
     With mymailitem
    
      Sheet1.Cells(i, 1) = .Subject
      Sheet1.Cells(i, 2) = .SenderName
      Sheet1.Cells(i, 3) = .Body
      
         
     End With
  Next
     
      xlapp.quit
 End Sub
**********************************************************************
2、导出成文本文件：
 
  Sub Exprot_Mail_txtfile()

  Dim myolapp As New Outlook.Application
 
  Set myNameSpace = myolapp.GetNamespace("MAPI")
  Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
   
  For i = 1 To myfolder.Items.Count  '简单for...next循环，将所有邮件导出，myfolder.Items.Count是收件箱里邮件的数量
   
  Set mymailitem = myfolder.Items(i)
    
     With mymailitem
    
      .SaveAs "c:\电子邮件\" + .Subject + ".txt", olTXT      
         
     End With
  Next
     
      xlapp.quit
 End Sub
 

****************************************************

提供将邮件里的附件保存至硬盘的代码。

上次提供了将“收件箱”里邮件导出至硬盘的代码。这次提供将邮件里的附件保存至硬盘的代码。
 
 Sub Exprot_Mail_Attachments()
  
 On Error Resume Next
 
  Dim myolapp As New Outlook.Application
  
  Set myNameSpace = myolapp.GetNamespace("MAPI")
  Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
   
  For i = 1 To myfolder.Items.Count
   
  Set mymailitem = myfolder.Items(i)
    
     With mymailitem
        
      Set myAttachments = mymailitem.Attachments
       
       myAttachments.Item(1).SaveAsFile "C:\电子邮件\" + IIf(IsNull(myAttachments.Item(1).DisplayName), i, myAttachments.Item(1).DisplayName)
      
              
     End With
  Next
 
  
 
End Sub