精华内容
下载资源
问答
  • outlook vba

    2011-04-13 01:28:02
    outlook vba outlook vba outlook vba outlook vba outlook vba outlook vba outlook vba outlook vba
  • Outlook VBA.docx

    2021-02-26 17:16:15
    Outlook VBA.docx
  • outlook vba check Excel

    2014-05-16 11:38:21
    outlook vba check Excel vba 自动检查附件excel并下载到指定文件夹
  • outlook VBA 自动保存邮件及附件代码
  • Outlook VBA开发第七讲-收到邮件时自动回复
  • Outlook VBA开发第三讲-导出Contact 生成Excel文件,关键是代码的编写,作个参考。
  • Outlook VBA开发第八讲-按发件人自动分类邮件
  • outlook vba 2

    2019-02-25 17:07:00
    转载于:https://www.cnblogs.com/itzxy/p/10431953.html

     

    转载于:https://www.cnblogs.com/itzxy/p/10431953.html

    展开全文
  • outlook vba 1

    2019-02-22 18:31:00
    转载于:https://www.cnblogs.com/itzxy/p/10420006.html

     

    转载于:https://www.cnblogs.com/itzxy/p/10420006.html

    展开全文
  • Outlook VBA开发第六讲-收回(Recall)刚发送的邮件
  • outlook vba开发要点

    2019-09-24 03:26:41
    https://www.yiibai.com/vba/vba_programming_charts.html 2.找一个样例看看 VBA编程实现自动回复邮件 https://blog.csdn.net/tclxspy/article/details/50714783 3.改造样例 取msdn上看看开发文档 ...

    1.学学基础的VB语法

    https://www.yiibai.com/vba/vba_programming_charts.html

    2.找一个样例看看

    VBA编程实现自动回复邮件

    https://blog.csdn.net/tclxspy/article/details/50714783

    3.改造样例

    取msdn上看看开发文档

    https://docs.microsoft.com/zh-cn/office/vba/outlook/concepts/getting-started/using-macros-to-customize-outlook

    4.关键点

    实现方式:COM,VBA

    采用简单的方式实现VBA。

    5.坑

    (1)导入库

    VBA编程提示编译错误用户定义类型未定义:需要找到自己引用的库导入

    Q:如何在VBA中添加对InternetExplorer对象的引用?
    A:方法1:前期绑定:Alt+F11>VBE编辑环境>菜单栏>工具>引用>Microsoft Internet Controls

    ie库(internet controls),mshtml(microsoft html Object library),  microsoft xml library,   正则库,microsoft  activeX库,

    (2)activex 部件不能创建对象

    Set ie =CreateObject("InternetExplorer.Application")

    ie.visible=true
    ie.navigate "http://www.baidu.com"

    提示: "运行时错误'429': ActiveX 部件不能创建对象  "... : "Run-time error '429' ActiveX componnent can't create object"...

    a.设置工具--引用 microsoft ActiveX data objects 2.0 library

    b.Internet选项 - 安全设置里,恢复为默认级别。

    Internet选项 - 安全设置里面,可以自定义级别,只要确保ActiveX控件是启用状态。

    (3)

    6.开发技巧:

    (1) alt + F11打开开发ide

    (2) ctrl + g 打开立即窗口,调试信息输出

    (3) 视图——>监视窗口,打开变量监控窗口

    (4)单步调试 F8

    7.VBA IE对象的操作方法

    http://www.360doc.com/content/18/0223/17/52075843_731761102.shtml

    https://blog.csdn.net/kendyhj9999/article/details/52267469?locationNum=4&fps=1

    8.VBA面向对象

    http://mini.eastday.com/mobile/170603152045489.html

    demo1

    '邮件自动转发处理子程序
    '功能:根据发件人过滤,读取未读邮件,转发邮件
    '
    '
    
    Sub AutoForward(rcvMail As Outlook.MailItem)
        '定义邮件转发项目
        Dim myAutoForwardMailItem As Outlook.MailItem
        Dim rcvhtmlBody  As String
        Dim rcvBody As String
        Dim mto As String
        Dim ie, dmt, bd
        '定义邮件体
        Dim myAutoForwardHTMLBody As String
        '创建邮件体
        myForwardHTMLBody = CreateHTMLBody(2)
    
        If (rcvMail.UnRead) And (rcvMail.SenderEmailAddress = "942387T841U@qq.com") Or (rcvMail.SenderEmailAddress = "rdmod01@163.com") Or (rcvMail.SenderEmailAddress = "ju.li@163.com") Then
            '将邮件设为已读
            rcvMail.UnRead = False
            
            '设置转发器
            Set myAutoForwardMailItem = rcvMail.ReplyAll
            
            '设置收件人
            myAutoForwardMailItem.Recipients.Add "xx@qq.com"
            myAutoForwardMailItem.Recipients.Add "yy@qq.com"
        
             rcvhtmlBody = rcvMail.HTMLBody
             rcvBody = rcvMail.Body
             mto = rcvMail.To
             Debug.Print ("htmlBody string: " & rcvhtmlBody)
             Debug.Print ("Body string: " & rcvBody)
             Debug.Print ("Recipients: " & mto)
            '处理邮件内容
             Set ie = CreateObject("InternetExplorer.Application")
                
            
            '设置邮件体格式为outlook html格式
            myAutoForwardMailItem.BodyFormat = olFormatHTML
            
            '将原始邮件与新邮件连起来
            myAutoForwardMailItem.HTMLBody = myForwardHTMLBody & myAutoForwardMailItem.HTMLBody
            
            'Displays a new Inspector object for the item.
            'myAutoForwardMailItem.Display
            
            '发送邮件
            'Sends the e-mail message.
            myAutoForwardMailItem.Send
            
            '原保存邮件
            'Saves the Microsoft Outlook item to the current folder or, if this is a new item, to the Outlook default folder for the item type.
            rcvMail.Save
        End If
        
        '清空对象
        Set rcvMail = Nothing
        Set myAutoReplyMailItem = Nothing
    End Sub
    Sub AutoForward1()
       Debug.Print ("xxx:" & RemoveHTML)
    End Sub
    
    Public Function CreateHTMLBody(id As Integer) As String
        
        'Creates a new e-mail item and modifies its properties
        Dim objHTMLBody As String
        
        '可以设置多个模板
        If id = 1 Then
            objHTMLBody = _
            "<font face = 微软雅黑 size = 3>" & _
            "感谢你的来信。我是<font color=red>机器人小星</font>,邮件我已代为阅读。" & _
            "<br/> <br/> " & _
            "来自小星的智能转发</font>"
            
        ElseIf id = 2 Then
           objHTMLBody = _
           "<table style = border-collapse:collapse <tbody>" & _
           "<tr><td style = border:1px solid #B0B0B0 colspan= 2>版本</td></tr>" & _
           "<tr><td style= border:1px solid #B0B0B0 >APP版本</td></tr>" & _
           "<tr><td style = border:1px solid #B0B0B0>SDK版本</td></tr>" & _
           "</tbody></table>" & _
           "" & _
           "<br/> <br/> " & _
           "来自小星的智能回复</font>"
        End If
        CreateHTMLBody = objHTMLBody
    End Function
    
    Sub test()
      Dim str As String
      Dim result As String
      str = _
           "<table style = border-collapse:collapse <tbody>" & _
           "<tr><td style = border:1px solid #B0B0B0 colspan= 2>版本</td></tr>" & _
           "<tr><td style= border:1px solid #B0B0B0 >APP版本</td></tr>" & _
           "<tr><td style = border:1px solid #B0B0B0>SDK版本</td></tr>" & _
           "</tbody></table>" & _
           "" & _
           "<br/> <br/> " & _
           "来自小星的智能回复</font>"
      result = RemoveHTML(str)
      Debug.Print (result)
    End Sub
    
    '移除html标签
    
    Public Function RemoveHTML(strText As String)
        Dim nPos1
        Dim nPos2
         Debug.Print ("Body string: ")
        nPos1 = InStr(strText, "<")
        Do While nPos1 > 0
            nPos2 = InStr(nPos1 + 1, strText, ">")
            If nPos2 > 0 Then
                strText = Left(strText, nPos1 - 1) & Mid(strText, nPos2 + 1)
            Else
                Exit Do
            End If
            nPos1 = InStr(strText, "<")
        Loop
        
        RemoveHTML = strText
    End Function
    

      

    demo2

    Sub searchWebViaIE()
        Dim ie As SHDocVw.InternetExplorer
        Dim doc As MSHTML.HTMLDocument
        Dim anchors As MSHTML.IHTMLElementCollection
        Dim anchor As MSHTML.HTMLAnchorElement
        Dim prodSpec As MSHTML.HTMLAnchorElement
        Dim tableCells As MSHTML.IHTMLElementCollection
        Dim materialValueElement As MSHTML.HTMLTableCell
        Dim tableCell As MSHTML.HTMLTableCell
    
        Set ie = New SHDocVw.InternetExplorer
        'Set ie = CreateObject("InternetExplorer.Application")
    
    
        With ie
            .navigate "http://www.baidu.com"
            .Visible = True
    
            Do While .readyState <> READYSTATE_COMPLETE Or .Busy = True
                DoEvents
            Loop
    
            Set doc = .document
    
            Set anchors = doc.getElementsByTagName("a")
    
            For Each anchor In anchors
                If InStr(anchor.innerHTML, "Product Specificatie") <> 0 Then
                    anchor.Click
                    Exit For
                End If
            Next anchor
    
            Do While .readyState <> READYSTATE_COMPLETE Or .Busy = True
                DoEvents
            Loop
    
        End With
    
        For Each anchor In anchors
            If InStr(anchor.innerHTML, "Product Specificatie") <> 0 Then
                Set prodSpec = anchor
            End If
        Next anchor
    
        Set tableCells = doc.getElementById("list-table").getElementsByTagName("td")
    
        If Not tableCells Is Nothing Then
            For Each tableCell In tableCells
                If tableCell.innerHTML = "Materiaal" Then
                    Set materialValueElement = tableCell.NextSibling
                End If
            Next tableCell
        End If
    
        MsgBox materialValueElement.innerHTML
    
    End Sub
    

      demo3

    '邮件自动转发处理子程序
    '功能:根据发件人过滤,读取未读邮件,转发邮件
    '
    '
    
    Sub AutoForward(rcvMail As Outlook.mailitem)
        '定义邮件转发项目
        Dim myAutoForwardMailItem As Outlook.mailitem
        Dim rcvhtmlBody  As String
        Dim rcvBody As String
        Dim mto As String
        'Dim ie, dmt, bd
        Dim sender As String
        '定义邮件体
        Dim myAutoForwardHTMLBody As String
        
        Dim ie As SHDocVw.InternetExplorer
        
        Dim doc As MSHTML.HTMLDocument
        
        '创建邮件体
        myForwardHTMLBody = CreateHTMLBody(2)
    
        If (rcvMail.UnRead) And (rcvMail.SenderEmailAddress = "94s841@qq.com") Or (rcvMail.SenderEmailAddress = "rdmod01@163.com") Or (rcvMail.SenderEmailAddress = "ju.li@163.com") Then
            '将邮件设为已读
            rcvMail.UnRead = False
            
            '设置转发器
            Set myAutoForwardMailItem = rcvMail.ReplyAll
            'rcvMail.Attachments.item(1).SaveAsFile ("D:\")
            
         
            
            '设置收件人
            myAutoForwardMailItem.Recipients.Add "2s3016@qq.com"
            myAutoForwardMailItem.Recipients.Add "129s615@qq.com"
        
             rcvhtmlBody = rcvMail.HTMLBody
             rcvBody = rcvMail.body
             
             mto = rcvMail.To
             Debug.Print ("htmlBody string: " & rcvhtmlBody)
             Debug.Print ("Body string: " & rcvBody)
             Debug.Print ("Recipients: " & mto)
            '处理邮件内容
             'Set ie = CreateObject("InternetExplorer.Application")
             
             '保存附件
             saveAttachments rcvMail
             
             '解析邮件主体
             resolveAttach
             
             Set ie = New SHDocVw.InternetExplorer
             'Set doc = .document
       
            
            '设置邮件体格式为outlook html格式
            myAutoForwardMailItem.BodyFormat = olFormatHTML
            
            '将原始邮件与新邮件连起来
            myAutoForwardMailItem.HTMLBody = myForwardHTMLBody & myAutoForwardMailItem.HTMLBody
            
            'Displays a new Inspector object for the item.
            'myAutoForwardMailItem.Display
            
            '发送邮件
            'Sends the e-mail message.
            myAutoForwardMailItem.Send
            
            '原保存邮件
            'Saves the Microsoft Outlook item to the current folder or, if this is a new item, to the Outlook default folder for the item type.
            rcvMail.Save
        End If
        
        '清空对象
        Set rcvMail = Nothing
        Set myAutoReplyMailItem = Nothing
    End Sub
    
    Sub saveAttachments(mailitem As Outlook.mailitem)
        Dim olAtt As Attachment
        Dim count: count = mailitem.attachments.count
        Dim attachments: attachments = mailitem.attachments
        Dim i: i = 0
        While i < count
           i = i + 1
           '附件索引从1开始
           Set olAtt = attachments(i)
           olAtt.SaveAsFile "D:\firefly\" & olAtt.FileName
        Wend
    End Sub
    
    
    Sub resolveAttach()
        Dim ie As SHDocVw.InternetExplorer
        Dim doc As MSHTML.HTMLDocument
        Dim body As MSHTML.HTMLBody
        
        Set ie = New SHDocVw.InternetExplorer
        ie.Visible = False
        ie.navigate "D:\firefly\test.html"
        Do Until ie.readyState = 4 '检查网页是否加载完毕
         DoEvents '没有加载完毕就将权限还给系统
        Loop
        
        Set doc = ie.document
        Set body = doc.body
        body.
        
    End Sub
    
    Public Function CreateHTMLBody(id As Integer) As String
        
        'Creates a new e-mail item and modifies its properties
        Dim objHTMLBody As String
        
        '可以设置多个模板
        If id = 1 Then
            objHTMLBody = _
            "<font face = 微软雅黑 size = 3>" & _
            "感谢你的来信。我是<font color=red>机器人小星</font>,邮件我已代为阅读。" & _
            "<br/> <br/> " & _
            "来自小星的智能转发</font>"
            
        ElseIf id = 2 Then
           objHTMLBody = _
           "<table style = border-collapse:collapse <tbody>" & _
           "<tr><td style = border:1px solid #B0B0B0 colspan= 2>版本</td></tr>" & _
           "<tr><td style= border:1px solid #B0B0B0 >APP版本</td></tr>" & _
           "<tr><td style = border:1px solid #B0B0B0>SDK版本</td></tr>" & _
           "</tbody></table>" & _
           "" & _
           "<br/> <br/> " & _
           "来自小星的智能回复</font>"
        End If
        CreateHTMLBody = objHTMLBody
    End Function
    
    Sub test()
      Dim str As String
      Dim result As String
      str = _
           "<table style = border-collapse:collapse <tbody>" & _
           "<tr><td style = border:1px solid #B0B0B0 colspan= 2>版本</td></tr>" & _
           "<tr><td style= border:1px solid #B0B0B0 >APP版本</td></tr>" & _
           "<tr><td style = border:1px solid #B0B0B0>SDK版本</td></tr>" & _
           "</tbody></table>" & _
           "" & _
           "<br/> <br/> " & _
           "来自小星的智能回复</font>"
      result = RemoveHTML(str)
      Debug.Print (result)
    End Sub
    
    '移除html标签
    
    Public Function RemoveHTML(strText As String)
        Dim nPos1
        Dim nPos2
         Debug.Print ("Body string: ")
        nPos1 = InStr(strText, "<")
        Do While nPos1 > 0
            nPos2 = InStr(nPos1 + 1, strText, ">")
            If nPos2 > 0 Then
                strText = Left(strText, nPos1 - 1) & Mid(strText, nPos2 + 1)
            Else
                Exit Do
            End If
            nPos1 = InStr(strText, "<")
        Loop
        
        RemoveHTML = strText
    End Function
    

      

    '''
    '需求描述
    '公司里面每天都会有很多邮件,三分之一都是不需要看的,Outlook的过滤功能不错,都可以处理掉。还有些邮件,根据正文或者附件做一下处理自动转发出去就行了。于是上网搜集了一些资料,写个了小程序,共享一下,以后可以参考,也希望对大家有点用处。
    
    '实现
    '废话少说,直接上代码吧。打开Outlook,按Alt+F11打开代码编辑器,输入下面的代码。可能有些兄弟不知道怎么入手,后面会放几个链接做参考。
    
    '
    '编辑完保存,在”开始->规则->创建规则”中添加一个过滤规则,在”如何处理该邮件”中选择运行脚本,并选择这个脚本。
    
    Sub AutoResponseReceipt(item As mailitem)
        Debug.Print ("receive an email")
    
        Dim id As String
        Dim SubjectString As String
        Dim sender As String
        Dim email As Outlook.mailitem
    
        On Error GoTo Err
    
        id = item.EntryID                   ' 先获取邮件的ID
        Set email = Application.Session.GetItemFromID(id)
        SubjectString = email.Subject       ' 邮件主题
        sender = email.SenderEmailAddress   ' 邮件的发送人地址
        Debug.Print ("new email arrivaved: subject is " & SubjectString & "  sender is " & sender)
        Debug.Print ("new email arrivaved: subject is " & SubjectString & "  recvs is " & email.Recipients)
    
        ' 校验主题,这里是对主题做过滤,不合适的直接返回不处理
        Dim index As Integer
        index = InStr(SubjectString, "小票")
        If 0 = index Then
            index = InStr(SubjectString, "receipt")
            If 0 = index Then
                Return
            End If
        End If
    
        ' 下面这一段是我自己的一些处理逻辑,调用程序处理附件,
        ' 然后将程序处理后的结果当做附件转发给另一个人
    
        ' 获取附件并执行小票生成程序
        Dim PathPrefix As String
        PathPrefix = "E:\document\receipt_tool\"
        Dim InputFileList As New Collection         ' 这个列表存放收到的附件
        Dim OutputFileList As New Collection        ' 存放程序生成的结果
        Dim AttachFile As Attachment                ' 附件
    
        For Each AttachFile In email.attachments    ' email.attachments是所有附件
            Debug.Print ("attachment: " & AttachFile.FileName)
    
            Dim InputFile As String
            Dim OutputFile As String
            InputFile = PathPrefix & AttachFile.FileName
            OutputFile = PathPrefix & AttachFile.FileName & ".docx"
            Debug.Print ("input file is " & InputFile)
            Debug.Print ("output file is " & OutputFile)
    
            AttachFile.SaveAsFile (InputFile)       ' 保存附件
            Dim cmd As String
            cmd = """" & PathPrefix & "receipt.exe" & """" & " " & InputFile & " " & OutputFile
            Debug.Print ("command string: " & cmd)
            Shell (cmd)                             ' 执行脚本,生成结果
            InputFileList.Add (InputFile)
            OutputFileList.Add (OutputFile)
    
            'Kill (InputFile)   ' 这里删除的话总会把生成的文件同时删掉
        Next
    
        If OutputFileList.count = 0 Then
            Debug.Print ("no attachment")
        End If
    
        ' 转发邮件
        Dim OutMail As Object
        Set OutMail = Outlook.Application.CreateItem(olMailItem)
        With OutMail
            .To = "hnwyllmm@126.com"                ' 要转发邮件的收件人地址
            .Subject = "打印:" & email.Subject     ' 转发邮件的主题
            .body = "帮忙打印小票,谢谢!" & Chr(10) & email.SenderEmailAddress & Chr(10) & email.SenderName ' 转发邮件的正文
        End With
    
        Dim SendAttach As String                    ' 将程序生成的结果添加到附件中
        For i = 1 To OutputFileList.count
    '            MsgBox (SendAttach)
            SendAttach = OutputFileList(i)
            OutMail.attachments.Add (SendAttach)
        Next
        MsgBox ("send")
        OutMail.Send                                ' 发送邮件
        OutMail.Delete                              ' 删除邮件,没用了
    
    Err:
        ' 删除生成的文件
        For i = 1 To OutputFileList.count
            Kill (OutputFileList(i))
        Next
    
        For i = 1 To InputFileList.count
            Kill (InputFileList(i))
        Next
    
        email.Delete                                ' 删除收到的邮件
    
        ' 下面几个是释放对象,其实没有也无所谓
        Set InputFileList = Nothing
        Set OutputFileList = Nothing
        Set OutMail = Nothing
    
    End Sub
    

      

    Sub Command1_Click7()
        Dim str As String
        Dim li, cd
        Dim c_name As String
        '遍历元素<li>
        For Each li In Dom.document.getElementsByTagName("li")
            '用判断忽略掉列首名称的<li>行
            If li.classname = "lst_row" Then
                '遍历<li>下的节点
                For Each cd In li.ChildNodes
                    '判断是否为元素节点
                    If cd.NodeType <> 3 Then
                        If cd.classname = "col_2" Then
                            '如果是第2列的<span>,那么再用firstChild取出第一个元素节点<a>
                            str = str & cd.FirstChild.href & " "
                        Else
                            '其他列直接输出文本
                            str = str & cd.innertext & " "
                        End If
                    End If
                Next
                str = str & vbCrLf
            End If
        Next
        Print str
    End Sub
    

      

    Sub ParseMaterial()
    
        Dim Cell As Integer
        Dim ItemNbr As String
    
        Dim AElement As Object
        Dim AElements As IHTMLElementCollection
        Dim ie As MSXML2.XMLHTTP60
        Set ie = New MSXML2.XMLHTTP60
    
    Dim HTMLDoc As MSHTML.HTMLDocument
    Dim HTMLBody As MSHTML.HTMLBody
    
    Set HTMLDoc = New MSHTML.HTMLDocument
    Set HTMLBody = HTMLDoc.body
    
    For Cell = 1 To 5                            'I iterate through the file row by row
    
        ItemNbr = Cells(Cell, 3).Value           'ItemNbr isin the 3rd Column of my spreadsheet
    
        ie.Open "GET", "http://www.example.com/?item=" & ItemNbr, False
        ie.Send
    
        While ie.readyState <> 4
            DoEvents
        Wend
    
        HTMLBody.innerHTML = ie.responseText
    
        Set AElements = HTMLDoc.getElementById("list-table").getElementsByTagName("tr")
        For Each AElement In AElements
            If AElement.Title = "Material" Then
                Cells(Cell, 14) = AElement.NextNode.Value     'I write the material in the 14th column
            End If
        Next AElement
    
            Application.Wait (Now + TimeValue("0:00:2"))
    
    Next Cell
    End Sub
    

      

    <html>
    
    <body>
    
    <table width="400" border="1">
     <tr>
      <th align="left">消费项目....</th>
      <th align="right">一月</th>
      <th align="right">二月</th>
     </tr>
     <tr>
      <td align="left">衣服</td>
      <td align="right">241.10</td>
      <td align="right">50.20</td>
     </tr>
     <tr>
      <td align="left">化妆品</td>
      <td align="right">30.00</td>
      <td align="right">44.45</td>
     </tr>
     <tr>
      <td align="left">食物</td>
      <td align="right">730.40</td>
      <td align="right">650.00</td>
     </tr>
     <tr>
      <th align="left">总计</th>
      <th align="right">1001.50</th>
      <th align="right">744.65</th>
     </tr>
    </table>
    
    <p>每个表格由 table 标签开始。</p>
    <p>每个表格行由 tr 标签开始。</p>
    <p>每个表格数据由 td 标签开始。</p>
    
    <h4>一列:</h4>
    <table border="1">
    <tr>
      <td>100</td>
    </tr>
    </table>
    
    <h4>一行三列:</h4>
    <table border="1">
    <tr>
      <td>100</td>
      <td>200</td>
      <td>300</td>
    </tr>
    </table>
    
    <h4>两行三列:</h4>
    <table border="1">
    <tr>
      <td>100</td>
      <td>200</td>
      <td>300</td>
    </tr>
    <tr>
      <td>400</td>
      <td>500</td>
      <td>600</td>
    </tr>
    </table>
    <table border="6">
    <caption>我的标题</caption>
    <tr>
      <td>100</td>
      <td>200</td>
      <td>300</td>
    </tr>
    <tr>
      <td>400</td>
      <td>500</td>
      <td>600</td>
    </tr>
    </table>
    
    <h4>Disc 项目符号列表:</h4>
    <ul type="disc">
     <li>苹果</li>
     <li>香蕉</li>
     <li>柠檬</li>
     <li>桔子</li>
    </ul>  
    
    <h4>Circle 项目符号列表:</h4>
    <ul type="circle">
     <li>苹果</li>
     <li>香蕉</li>
     <li>柠檬</li>
     <li>桔子</li>
    </ul>  
    
    <h4>Square 项目符号列表:</h4>
    <ul type="square">
     <li>苹果</li>
     <li>香蕉</li>
     <li>柠檬</li>
     <li>桔子</li>
    </ul>  
    <h4>数字列表:</h4>
    <ol>
     <li>苹果</li>
     <li>香蕉</li>
     <li>柠檬</li>
     <li>桔子</li>
    </ol>  
    
    <h4>字母列表:</h4>
    <ol type="A">
     <li>苹果</li>
     <li>香蕉</li>
     <li>柠檬</li>
     <li>桔子</li>
    </ol>  
    
    <h4>小写字母列表:</h4>
    <ol type="a">
     <li>苹果</li>
     <li>香蕉</li>
     <li>柠檬</li>
     <li>桔子</li>
    </ol>  
    
    <h4>罗马字母列表:</h4>
    <ol type="I">
     <li>苹果</li>
     <li>香蕉</li>
     <li>柠檬</li>
     <li>桔子</li>
    </ol>  
    
    <h4>小写罗马字母列表:</h4>
    <ol type="i">
     <li>苹果</li>
     <li>香蕉</li>
     <li>柠檬</li>
     <li>桔子</li>
    </ol>  
    
    
    <h4>一个嵌套列表:</h4>
    <ul>
      <li>咖啡</li>
      <li>茶
        <ul>
        <li>红茶</li>
        <li>绿茶</li>
        </ul>
      </li>
      <li>牛奶</li>
    </ul>
    
    </body>
    </html>
    

      

    <!DOCTYPE html>
    <html>
    <head>
        <title>test</title>
    </head>
    <body>
    <div>
    <ul class="lstbox"> 
        <li class="lst_head"><span class="col_1">姓名</span><span class="col_2">邮箱</span><span class="col_3">生日</span></li>
        <li class="lst_row"><span class="col_1">张三</span><span class="col_2"><a href="mailto:zhangsan@web.com" class="email">zhangsan</a></span><span class="col_3">80-5-1</span></li>
        <li class="lst_row"><span class="col_1">李四</span><span class="col_2"><a href="mailto:lisi@web.com" class="email">lisi</a></span><span class="col_3">85-5-1</span></li>
        <li class="lst_row"><span class="col_1">王五</span><span class="col_2"><a href="mailto:wangwu@web.com" class="email">wangwu</a></span><span class="col_3">90-5-1</span></li>
        <li class="lst_row"><span class="col_1">赵六</span><span class="col_2"><a href="mailto:zhaoliu@web.com" class="email">zhaoliu</a></span><span class="col_3">95-5-1</span></li>
    </ul>
    </div>
    </body>
    </html>
    

      


    将显示名称映射到电子邮件地址
    https://docs.microsoft.com/zh-cn/office/vba/outlook/concepts/address-book/map-a-display-name-to-an-e-mail-address

    获取收件人的电子邮件地址
    https://docs.microsoft.com/zh-cn/office/vba/outlook/concepts/address-book/obtain-the-e-mail-address-of-a-recipient

    中文

    https://msdn.microsoft.com/zh-cn/library/ee814736.aspx

     http://www.snb-vba.eu/VBA_Outlook_external_en.html#L_3.2.1

    转载于:https://www.cnblogs.com/yuhuameng/p/9692042.html

    展开全文
  • outlook中追加vba 代码, 通过cmd命令发送 ipmsg信息。
  • outlook VBA编程

    2008-11-28 13:42:21
    这是一个比较简单的VBA编程书籍。适合初学者使用。
  • Option Explicit ...' VBA Script that gets info on the currently selected email using propertyAccessor and various syntaxes ' (see other scripts at http://www.GregThatcher.com for other ways to...
    Option Explicit
    
    ' VBA Script that gets info on the currently selected email using propertyAccessor and various syntaxes
    ' (see other scripts at http://www.GregThatcher.com for other ways to get email properties)
    ' Property Tag Syntax looks like this http://schemas.microsoft.com/mapi/proptag/0x0005000b
    ' Property Tag Syntax is used for Outlook 'Properties' (defined by Outlook Object Model)
    '
    ' Property ID Syntax looks like this http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8586001f
    ' Property ID Syntax is used for MAPI Named Properties (optional Outlook properties that can't be deleted) and UserProperties (properties you can add which are visible to the user)
    '
    ' Named Property Syntax looks like this http://schemas.microsoft.com/mapi/string folloowed by a property name
    ' Named Property Syntax is used to create and view 'Named Properties" (properties you can create, but which are not visible to the user)
    '
    ' Office document syntax looks like this: urn:schemas-microsoft-com:office:outlook#source-table-label
    '
    ' Use Tools->Macro->Security to allow Macros to run, then restart Outlook
    ' Run Outlook, Press Alt+F11 to open VBA
    ' Programming by Greg Thatcher, http://www.GregThatcher.com
    ' THIS SCRIPT WILL ONLY RUN ON OUTLOOK 2007 OR LATER (it won't work on Outlook 2003 -- there is no propertyAccessor)
    '
    ' To find the DASL definition of Outlook Properties, use the method described in Professional Outlook 2007 Programming (Programmer to Programmer) by Ken Slovak
    ' From the 'Views' menu, create a new view (but don't save it)
    ' Click on the 'Advanced' tab, and choose 'Filter'
    ' Choose a Field from the 'Field' dropdown, also choose a condition and value
    ' Click on the 'Sql tab'
    ' Check the 'Edit these Criteria' checkbox
    '
    
    Public Sub GetCurrentMailInfoUsingpropertyAccessor()
        Dim Session As Outlook.NameSpace
        Dim currentExplorer As Explorer
        Dim Selection As Selection
        Dim currentItem As Object
        Dim currentMail As MailItem
        Dim report As String
        Dim propertyAccessor As Outlook.PropertyAccessor
        Dim stringArray() As String
        Dim index
        Dim currentString
        Dim tempVal
        
        Set currentExplorer = Application.ActiveExplorer
        Set Selection = currentExplorer.Selection
        
        'for all items do...
        For Each currentItem In Selection
            If currentItem.Class = olMail Then
                Set currentMail = currentItem
                
                Set propertyAccessor = currentMail.PropertyAccessor
        
                
            
                report = report & AddToReportIfNotBlank("Auto Forwarded", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0005000b")) & vbCrLf
                report = report & AddToReportIfNotBlank("Bcc", propertyAccessor.GetProperty("urn:schemas:calendar:resources")) & vbCrLf
                report = report & AddToReportIfNotBlank("Billing Information", propertyAccessor.GetProperty("urn:schemas:contacts:billinginformation")) & vbCrLf
                stringArray() = propertyAccessor.GetProperty("urn:schemas-microsoft-com:office:office#Keywords")
                For index = LBound(stringArray) To UBound(stringArray)
                    report = report & "Categories (" & index & ") " & stringArray(index) & vbCrLf
                Next index
                report = report & AddToReportIfNotBlank("Cc", propertyAccessor.GetProperty("urn:schemas:httpmail:displaycc")) & vbCrLf
                report = report & AddToReportIfNotBlank("Changed By", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3ffa001f")) & vbCrLf
                report = report & AddToReportIfNotBlank("Contacts", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8586001f")) & vbCrLf
                report = report & AddToReportIfNotBlank("Conversation", propertyAccessor.GetProperty("urn:schemas:httpmail:thread-topic")) & vbCrLf
                report = report & AddToReportIfNotBlank("Created", propertyAccessor.GetProperty("urn:schemas:calendar:created")) & vbCrLf
                report = report & AddToReportIfNotBlank("Defer Until", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/deferred-delivery-iso")) & vbCrLf
                report = report & AddToReportIfNotBlank("Do Not AutoArchive", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/850e000b")) & vbCrLf
    
                report = report & AddToReportIfNotBlank("Due Date", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81050040")) & vbCrLf
                report = report & AddToReportIfNotBlank("E-mail Account", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8580001f")) & vbCrLf
                report = report & AddToReportIfNotBlank("Expires", propertyAccessor.GetProperty("urn:schemas:mailheader:expiry-date")) & vbCrLf
                report = report & AddToReportIfNotBlank("Flag Complated Date", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10910040")) & vbCrLf
                report = report & AddToReportIfNotBlank("Flag Status", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10900003")) & vbCrLf
                report = report & AddToReportIfNotBlank("Follow Up Flag", propertyAccessor.GetProperty("urn:schemas:httpmail:messageflag")) & vbCrLf
                report = report & AddToReportIfNotBlank("From", propertyAccessor.GetProperty("urn:schemas:httpmail:fromname")) & vbCrLf
                report = report & AddToReportIfNotBlank("Have Replies Sent To", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0050001f")) & vbCrLf
                report = report & AddToReportIfNotBlank("IMAP Status", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85700003")) & vbCrLf
                report = report & AddToReportIfNotBlank("Importance", propertyAccessor.GetProperty("urn:schemas:httpmail:importance")) & vbCrLf
                'report = report & AddToReportIfNotBlank("In Folder", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0e05001f")) & vbCrLf
                report = report & AddToReportIfNotBlank("InfoPath Form Type", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85b1001f")) & vbCrLf
                'report = report & AddToReportIfNotBlank("Message", propertyAccessor.GetProperty("urn:schemas:httpmail:textdescription")) & vbCrLf
                report = report & AddToReportIfNotBlank("Message Class", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x001a001e")) & vbCrLf
                report = report & AddToReportIfNotBlank("Mileage", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/mileage")) & vbCrLf
                report = report & AddToReportIfNotBlank("Modified", propertyAccessor.GetProperty("DAV:getlastmodified")) & vbCrLf
                report = report & AddToReportIfNotBlank("Originator Delivery Requested", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/deliveryreportrequested")) & vbCrLf
                'report = report & AddToReportIfNotBlank("Outlook Data File", propertyAccessor.GetProperty("urn:schemas-microsoft-com:office:outlook#source-table-label")) & vbCrLf
                report = report & AddToReportIfNotBlank("Outlook Internal Version", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85520003")) & vbCrLf
                report = report & AddToReportIfNotBlank("Outlook Version", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8554001f")) & vbCrLf
                report = report & AddToReportIfNotBlank("Receipt Requested", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/readreceiptrequested")) & vbCrLf
                report = report & AddToReportIfNotBlank("Received", propertyAccessor.GetProperty("urn:schemas:httpmail:datereceived")) & vbCrLf
                report = report & AddToReportIfNotBlank("Received Representing Name", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0044001f")) & vbCrLf
                'report = report & AddToReportIfNotBlank("Recipient Name", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/received_by_name")) & vbCrLf
                report = report & AddToReportIfNotBlank("Relevance", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10840003")) & vbCrLf
                report = report & AddToReportIfNotBlank("Reminder", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8503000b")) & vbCrLf
                report = report & AddToReportIfNotBlank("Remote Status", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85110003")) & vbCrLf
                'report = report & AddToReportIfNotBlank("Retrieval Time", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062014-0000-0000-C000-000000000046}/8f040003")) & vbCrLf
                'report = report & AddToReportIfNotBlank("RSS Feed", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062041-0000-0000-C000-000000000046}/8904001f")) & vbCrLf
                report = report & AddToReportIfNotBlank("Sensitivity", propertyAccessor.GetProperty("http://schemas.microsoft.com/exchange/sensitivity-long")) & vbCrLf
                report = report & AddToReportIfNotBlank("Sent", propertyAccessor.GetProperty("urn:schemas:httpmail:date")) & vbCrLf
                report = report & AddToReportIfNotBlank("Signed By", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00020328-0000-0000-C000-000000000046}/9104001f")) & vbCrLf
                report = report & AddToReportIfNotBlank("Start Date", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062003-0000-0000-C000-000000000046}/81040040")) & vbCrLf
                report = report & AddToReportIfNotBlank("Subject", propertyAccessor.GetProperty("urn:schemas:httpmail:subject")) & vbCrLf
                report = report & AddToReportIfNotBlank("Task Subject", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85a4001f")) & vbCrLf
                report = report & AddToReportIfNotBlank("To", propertyAccessor.GetProperty("urn:schemas:httpmail:displayto")) & vbCrLf
                report = report & AddToReportIfNotBlank("Tracking Status", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{0006200B-0000-0000-C000-000000000046}/88090003")) & vbCrLf
                report = report & AddToReportIfNotBlank("Voting Response", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8524001f")) & vbCrLf
               
            End If
        Next
        
        Call CreateReportAsEmail("Email properties from PropertyAccessor using various Property Syntaxes", report)
    End Sub
    
    
    Private Function AddToReportIfNotBlank(FieldName As String, FieldValue)
        AddToReportIfNotBlank = ""
        If (IsNull(FieldValue) Or FieldValue <> "") Then
            AddToReportIfNotBlank = FieldName & " : " & FieldValue & vbCrLf
        End If
        
    End Function
    
    ' VBA SubRoutine which displays a report inside an email
    ' Programming by Greg Thatcher, http://www.GregThatcher.com
    Public Sub CreateReportAsEmail(Title As String, report As String)
        On Error GoTo On_Error
    
        Dim Session As Outlook.NameSpace
        Dim mail As MailItem
        Dim MyAddress As AddressEntry
        Dim Inbox
    
        Set Session = Application.Session
        Set Inbox = Session.GetDefaultFolder(olFolderInbox)
        Set mail = Inbox.Items.Add("IPM.Mail")
    
        mail.Subject = Title
        mail.Body = report
    
        mail.Save
        mail.Display
        
    
    Exiting:
            Set Session = Nothing
            Exit Sub
    
    On_Error:
        MsgBox "error=" & Err.Number & " " & Err.Description
        Resume Exiting
    
    End Sub
    

    适用于:Outlook 2007 以上。

    转自: http://www.gregthatcher.com/Scripts/VBA/Outlook/GetEmailInfoUsingPropertyAccessor.aspx 

    转载于:https://www.cnblogs.com/yoyohappy/p/4453482.html

    展开全文
  • I'm creating a macro in Outlook to read file paths stored in an Excel file and create hyperlinks. I'm so close to getting it working but this last bit of code is driving me nuts. I have the string wit...
  • 下载链接如下 转载于:https://www.cnblogs.com/ryueifu-VBA/p/10933948.html
  • Outlook VBA自动处理邮件

    万次阅读 2015-04-04 17:39:17
    需求描述 公司里面每天都会有很多邮件,三分之一都是不需要看的,Outlook的过滤功能不错,都可以处理掉。还有些邮件,根据正文或者附件做一下处理自动转发出去就行了。于是上网搜集了一些资料,写个了小程序,共享...
  • outlook中使用vba搜索邮件使用了advancedsearch函数,其中的filter参数要使用dasl,比如urn:schemas:httpmail:subject是搜索邮件的主题,请问比如要搜索正文,或者发件人等属性,这个dasl是什么样的,谢谢
  • 文档说明:添加按钮,实现带上附件的全部回复功能。 文档含有详细的代码和注释,适合办公者更完善使用outlook的功能。
  • 按发件人自动分类邮件,收到新邮件时,以发件人的名字在收件箱下建目录,然后把新邮件移动到此目录下。 提供详细的代码和注释,适合想了解outlookvba功能的办公者。
  • Outlook.olBCC Set oRecipient = oItem.Recipients.Add("arivn@email.com") oRecipient.Type = Outlook.olBCC Set oRecipient = oItem.Recipients.Add("arivn@email.com") oRecipient.Type = Outlook.olBCC oItem....
  • 需求描述公司里面每天都会有很多邮件,三分之一都是不需要看的,Outlook的过滤功能不错,都可以处理掉。还有些邮件,根据正文或者附件做一下处理自动转发出去就行了。于是上网搜集了一些资料,写个了小程序,共享...
  • outlook vba 插件

    千次阅读 2008-01-29 09:48:00
     Outlook.Recipient   Dim  intBegin, intEnd, intLength  As   Integer   Dim  strEntryID  As   String    intBegin  =   1  intLength  =   Len (EntryIDCollection)  intEnd  =   InStr ...
  • Outlook VBA 开发常用资料

    千次阅读 2009-09-16 15:27:00
    要对邮件箱里的邮件进行操作,首先要取得Outlook MAPI名字空间。可以使用下面的语句: Dim mobjOutlook As Outlook.NameSpace Dim objOutlook As New Outlook.Application mobjOutlook=objoutlook.GetNameSpace...
  • Option Explicit Sub TestFolder() 'Dim outlookapp, myitem, myfolder 'Dim mailcounts As Integer ...'Set outlookapp = CreateObject("outlook.application") ' Set myitem = outlookapp.Applicat...
  • outlook vba 插件2

    千次阅读 2008-03-05 12:59:00
     Outlook.Recipient   Dim  intBegin, intEnd, intLength  As   Integer   Dim  strEntryID  As   String    MailID  =  MailID  +   1  intBegin  =   1  intLength  =   Len ...
  • 俺们有两个邮箱,1个外部的邮箱1(outlook),1个内部邮箱0(lotus notes)。想要outlook邮箱收到新邮件之后...测试环境(xp+msft outlook),按alt+F11进入VBA编辑。注意要在工具 -> 宏 -> 安全性中设置为低...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 460
精华内容 184
关键字:

outlookvba