【请教dsd999版主如下伪代码的翻译, 希望各路高手也能一并指导下, 非常感谢!!】 : )

veggieg

请教dsd999版主如下伪代码的翻译, 希望各路高手也能一并指导下, 非常感谢!! : )

这些基本已经涵盖所有常用的基本收件管理功能了, 希望您能指导下这些少林武功啊, 非常感谢!! ^^

Sub 假设已安装OUTLOOK且该宏在EXCEL里使用
IF 邮件正文包含字符串"正文字符串" then
IF 邮件标题包含字符串"标题字符串" then
  IF 附件不为空 then (虽然有下句这句就多余了 但因为有其他用途所以希望提供)
   IF 附件名包含字符串"附件字符串" then
    IF 该收件的发送日期为/早于/晚于某日期 then           (3段代码 代码间有逻辑冲突 但主要是学习代码 希望都能提供 非常感谢！！)
     IF 该收件的发件人/收件人为"xxx@163.com" then   (2段代码 代码间有逻辑冲突 但主要是学习代码 希望都能提供 非常感谢！！)
      IF 该邮件已读/未读 then                                         (2段代码 代码间有逻辑冲突 但主要是学习代码 希望都能提供 非常感谢！！)
           导出邮件正文到EXCEL(文本方式/HTML方式)
           导出邮件标题到EXCEL
           另存附件到指定文件夹
           导出发件人邮箱地址
           导出收件人邮箱地址
           导出CC的邮箱地址
           '导出密送邮箱地址(这个代码不知道有没有,也不是很常用)
      End if
     End if
    End if
   End if
  End if
End if
End if   
End Sub

veggieg

感觉这些代码知道了 控制收发件的功能就都有了

其实这些代码也不多~ 就几十行 ^^

dsd999

[code=vb]If InStr(0, Item.Body, "") Then
    If InStr(0, Item.Subject, "") Then
    If Item.Attachments.count <> 0 Then
    If InStr(0, Item.Attachments(0).FileName, "") Then
    If Item.ReceivedTime > "" Then
    If InStr(0, Item.SenderName, "@163.com") Then
    If Item.UnRead = True Then
    End If
    End If
    End If
    End If
    End If
    End If
    End If[/code]

dsd999

这是一部份，剩下的  “导出邮件标题到EXCEL”这些， 可以看我的系列教程。

veggieg

dsd999 发表于 2013-10-18 14:11

DSD999版主您好

我尽量修改了代码了,但是还是有一些小问题没有解决,非常希望您能再指导下,非常感谢!

您的教程我觉得非常好,都实现了既定的功能,属于完善的软件,但是我个人提一点小小建议,就是这样完整的程序不太适合新手学习,我个人认为还是按EXCEL帮助那样,功能模块最小化,这样最容易记忆和理解,至于后期的排列组合无穷变化,就让学生自己完善啦 ^^ 就像以前我们读书学数学,先学基本概念,再学习高考题.直接上高考题,基本概念隐藏其中就不容易分离出来了.

搜索这个OL VBA中文资源还是很少的~希望您能在百忙中再抽时间教学下俺, OL VBA不像EXCEL VBA随便找到资源超级速成, 您5分钟写的代码或许我5天都很找不到呢~!


Option Explicit      '<--保留这个更好!
Sub MarcoInExcel()   '【备注:假设已安装OUTLOOK且该宏在EXCEL里使用】
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
If olApp Is Nothing Then MsgBox "Outlook.Application FAIL": Exit Sub

'需要dim下面两个变量为什么数据类型呢?
Set myNamespace = olApp.GetNamespace("MAPI")   '诡异无法创建ActiveX控件 这个以前是可以的哦
Set myFolder = myNamespace.GetDefaultFolder(6) '求教: 1.mynamespace是什么意思呢    2.(6)是简写吧 请问其英文是什么呢

Dim objItem As Object
Dim i&, j&
i = 2

For Each objItem In myFolder.items
  
  If InStr(1, objItem.Body, "正文字符串") > 0 Then
   If InStr(1, Item.Subject, "标题字符串") > 0 Then
    If Item.ReceivedTime > "2013-05-10" Then               '<-请问我这样写日期格式是否正确? 是否需使用日期比较f函数?
     If InStr(1, Item.SenderName, "XXX@163.com") > 0 Then  '<-请问收件人是ReceiverName ?
      If Item.UnRead = True Then
       If Item.Attachments.Count <> 0 Then

        
          For j = 0 To Item.Attachments.Count - 1              '请问是否0是第一份 还是1是第一份?
             If InStr(1, Item.Attachments(0).Filename, "附件名字符串") > 0 Then '<--需要遍历每个附件
        
                 Sheet1.Cells(i, 1) = objItem.SenderName
                 Sheet1.Cells(i, 2) = objItem.ReceiverName   '收件人的邮箱名 <--想象的代码 需请您更正
                 Sheet1.Cells(i, 3) = objItem.CCName           '抄送的邮箱名      <--想象的代码 需请您更正
                 Sheet1.Cells(i, 4) = objItem.BccName          '密送的邮箱名      <--想象的代码 需请您更正
                 Sheet1.Cells(i, 5) = objItem.Subject
                 Sheet1.Cells(i, 6) = objItem.Body
                 Sheet1.Cells(i, 7) = objItem.ReceivedTime
                 Sheet1.Cells(i, 8) = objItem.SendededTime   '发送时间           <--想象的代码 需请您更正
                 
                 '【另存附件到指定文件夹例如"D:\ABC"】
                 '【重要】如何实现在原邮件上回复的功能?
                 
                 i = i + 1
             End If
           Next j
        

       End If
      End If
     End If
    End If
   End If
  End If

Next

MsgBox "已完成"

End Sub

dsd999

[code=vb]Option Explicit      '<--保留这个更好!
Sub MarcoInExcel()   '【备注:假设已安装OUTLOOK且该宏在EXCEL里使用】
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
If olApp Is Nothing Then MsgBox "Outlook.Application FAIL": Exit Sub

'需要dim下面两个变量为什么数据类型呢?
Dim myNamespace As Outlook.Namespace

Set myNamespace = olApp.GetNamespace("MAPI")   '诡异无法创建ActiveX控件 这个以前是可以的哦
Set myFolder = myNamespace.GetDefaultFolder(6) '求教: 1.mynamespace是什么意思呢    2.(6)是简写吧 请问其英文是什么呢
'1 mynamespace是命名空间
'2 Const olFolderInbox = 6

Dim objItem As Object
Dim i&, j&
i = 2

For Each objItem In myFolder.items
  
  If InStr(1, objItem.Body, "正文字符串") > 0 Then
   If InStr(1, Item.Subject, "标题字符串") > 0 Then
    If Item.ReceivedTime > "2013-05-10" Then               '<-请问我这样写日期格式是否正确? 是否需使用日期比较f函数?
     If InStr(1, Item.SenderName, "XXX@163.com") > 0 Then  '<-请问收件人是ReceiverName ?    收件人是  Property Recipients As Recipients
      If Item.UnRead = True Then
       If Item.Attachments.Count <> 0 Then

        
          For j = 0 To Item.Attachments.Count - 1              '请问是否0是第一份 还是1是第一份?   1是第一份
             If InStr(1, Item.Attachments(0).Filename, "附件名字符串") > 0 Then '<--需要遍历每个附件
        
                 Sheet1.Cells(i, 1) = objItem.SenderName
                 Sheet1.Cells(i, 2) = objItem.ReceiverName   '收件人的邮箱名 <--想象的代码 需请您更正  收件人需要遍历
                 Sheet1.Cells(i, 3) = objItem.CC           '抄送的邮箱名      <--想象的代码 需请您更正
                 Sheet1.Cells(i, 4) = objItem.BCC          '密送的邮箱名      <--想象的代码 需请您更正
                 Sheet1.Cells(i, 5) = objItem.Subject
                 Sheet1.Cells(i, 6) = objItem.Body
                 Sheet1.Cells(i, 7) = objItem.ReceivedTime
                 Sheet1.Cells(i, 8) = objItem.SentOn   '发送时间           <--想象的代码 需请您更正
                 
                 '【另存附件到指定文件夹例如"D:\ABC"】
                 '【重要】如何实现在原邮件上回复的功能?
                 
                 i = i + 1
             End If
           Next j
        

       End If
      End If
     End If
    End If
   End If
  End If

Next

MsgBox "已完成"

End Sub
[/code]

dsd999

1）时间比较有多个方法，你在网上搜搜，找个适合的。
2）收件人是个集合
Property Recipients As Recipients
得到每个收件人需要遍历。
3）保存附件的代码
[code=vb]Sub SaveAttachment()
        Dim myOlApp As Outlook.Application
        Dim myInspector As Outlook.Inspector
        Dim myItem As Outlook.MailItem
        Dim myAttachments As Outlook.Attachments
        Set myOlApp = CreateObject("Outlook.Application")
        Set myInspector = myOlApp.ActiveInspector
        If Not TypeName(myInspector) = "Nothing" Then
                If TypeName(myInspector.CurrentItem) = "MailItem" Then
                        Set myItem = myInspector.CurrentItem
                        Set myAttachments = myItem.Attachments
                        'Prompt the user for confirmation
                        Dim strPrompt As String
                        strPrompt = "Are you sure you want to save the first attachment in the current item to the C:\ folder? If a file with the same name already exists in the destination folder, it will be overwritten with this copy of the file."
                        If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
                                myAttachments.Item(1).SaveAsFile "C:\" & _
                                myAttachments.Item(1).DisplayName
                        End If
                Else
                        MsgBox "The item is of the wrong type."
                End If
        End If
End Sub[/code]
4）outlook也有你说的excel的那种帮助。

veggieg

dsd999 发表于 2013-10-22 10:01

dsd999版主您好, 这些问题都因为您的代码而解决了, 非常非常感谢您!!

希望能再请教下您一个问题

就是获取的邮件.body 里面有表格有的邮件会获取不到表格, 里面没有vbtab, 请教您如何能获取到.body的表格呢? (感觉那个vbtab获取不到~)
另外CC的邮件地址不知道是用什么代码获取的呢? 希望您能再指导下, 非常感谢!!

dsd999

1)试试  .HTMLBody
2)抄送的邮件地址就用cc

veggieg

dsd999 发表于 2014-1-13 11:19
1)试试  .HTMLBody
2)抄送的邮件地址就用cc

HTML获取到了HTML的原代码 变的好长了 感觉要写很复杂的算法才能提取出表格~

另外CC获取不到@后面的地址 请教您应该怎么修改下代码呢?