精华内容
下载资源
问答
  • Outlook VBA开发第七讲-收到邮件时自动回复
  • Outlook VBA开发第三讲-导出Contact 生成Excel文件,关键是代码的编写,作个参考。
  • Outlook VBA开发第八讲-按发件人自动分类邮件
  • Outlook VBA开发第六讲-收回(Recall)刚发送的邮件
  • outlook vba开发要点

    2019-09-24 03:26:41
    1.学学基础的VB语法 https://www.yiibai.com/vba/vba_programming_charts.html 2.找一个样例看看 VBA编程实现自动回复邮件 ... 3.改造样例 取msdn上看看开发文档 https://docs.microsoft...

    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

    展开全文
  • 下载链接如下 转载于:https://www.cnblogs.com/ryueifu-VBA/p/10933948.html

    下载链接如下

     

    转载于:https://www.cnblogs.com/ryueifu-VBA/p/10933948.html

    展开全文
  • 按发件人自动分类邮件,收到新邮件时,以发件人的名字在收件箱下建目录,然后把新邮件移动到此目录下。 提供详细的代码和注释,适合想了解outlookvba功能的办公者。
  • Outlook VBA 开发常用资料

    千次阅读 2009-09-16 15:27:00
    要对邮件箱里的邮件进行操作,首先要取得Outlook MAPI名字空间。可以使用下面的语句: Dim mobjOutlook As Outlook.NameSpace Dim objOutlook As New Outlook.Application mobjOutlook=objoutlook.GetNameSpace...

      要对邮件箱里的邮件进行操作,首先要取得Outlook MAPI名字空间。可以使用下面的语句:


       Dim mobjOutlook As Outlook.NameSpace


       Dim objOutlook As New Outlook.Application


       mobjOutlook=objoutlook.GetNameSpace(“MAPI”)


       用mobjOutlook的GetDefaultFolder方法。可以取得收件箱的MAPIFolder对象:


       Dim objFolder As Outlook.MAPIFolder


       ObjFolder=mobjOutlook.GetDefaultFolder(6)


       其中参数6代表收件箱,其他参数的意义如下表:


       常量

    数值

    描述


       OlFolderDeletedItems 3

    已删除邮件


    OlFolderOutbox 4

    发件箱


    OlFolderSentMail 5

    已发件邮件


    olFolderInbox 6

    收件箱

    OlFolderCalendar 9

    日历

    OlFolderContacts 10

    联系人


    olFolderJournal 11

    日记

    olFolderNotes 12

    便笺


    olFolderTasks 13

    任务

    olFolderDrafts 16

    草稿

    展开全文
  • 需求:添加按钮,实现带上附件的全部回复功能。 Outlook版本:2003。
  • 保存选中邮件的所有附件到一个目录中 关键是如何编写代码
  • 导出邮件到Excel,每个发件人一个Sheet
  • 统计每个发件人所发邮件的数量 希望能和大家交流
  • 问题是 当这个excelMacro经outlook vba script 触发 他就只能读取邮件内容至251行, 可单独手动触发excel Macro 邮件全部内容可被读取。有没有大神能教教我如何解决这个问题啊? 下面是monitor邮件的部分,当指定...
  • 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 ...
    '定義された変数
    Dim DelAfterHandle As Boolean
    Dim Question, Reply, LogPath, DFMailList, strBody, strSubject, strUser As String
    Option Explicit

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    End Sub

    '受信時の動作
    Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
        
    '---------------------------
        '自分定義data
        '処理完了後で削除falg デフォルト状態は削除しない(目前は使用しない)
        DelAfterHandle = False
        
    '指定ログファイルパス
        LogPath = "E:MailRule"
        
    '内部係メールアドレスリスト
        DFMailList = ""
        
    '---------------------------
        '受信したメール
        Dim objMail As Object
        
    '発送や転送の新しいメール
        Dim NewMailItem As Outlook.MailItem
        
    'アドレスを追加用の変数
        Dim myRecipient As Outlook.Recipient
        
    Dim intBegin, intEnd, intLength As Integer
        
    Dim strEntryID As String
        
        intBegin 
    = 1
        intLength 
    = Len(EntryIDCollection)
        intEnd 
    = InStr(intBegin, EntryIDCollection, ",")
        
    If intEnd = 0 Then intEnd = intLength + 1
        
    Do While intEnd <> 0
            strEntryID 
    = Mid(EntryIDCollection, intBegin, (intEnd - intBegin))
            
    '受信の新しいメールを取得
            Set objMail = Application.Session.GetItemFromID(strEntryID)
                
    '送信アドレスによって、受信の新しいメールは内部からメールかどうかを判断
                strUser = objMail.SenderEmailAddress
                
    If InStr(1, DFMailList, objMail.SenderEmailAddress) <> 0 Then
                    
    '内部アドレス場合、ユーザへ発送
                    '件名は指定格式を満足かどうかを判断
                    If GetSubjectAndUser(objMail.Subject) <> False Then
                        
    '件名は指定格式を満足すれば
                        '問題と答え内容を取得できるかどうかを判断
                        If GetAnswerAndReply(objMail.Body) <> False Then
                            
    '問題と答え内容を取得できれば
                            Set NewMailItem = Application.CreateItem(olMailItem)
                            strBody 
    = objMail.HTMLBody
                            
    With NewMailItem
                                .BodyFormat 
    = olFormatHTML
                                .HTMLBody 
    = objMail.HTMLBody
                                .Subject 
    = strSubject
                            
    End With
                            NewMailItem.Recipients.Add (strUser)
                            NewMailItem.Send
                            Open LogPath 
    + "Logs.txt" For Append As #2
                            
    Print #2"[" + Format(Now, "yyyy-mm-dd hh:mm:ss"+ "]から" + objMail.SenderEmailAddress + "受信メール " + objMail.Subject + " という件もう代わりました!"
                            Close #
    2
                        
    Else
                            
    'もし問題と答え内容を取得できなければ、「答えメールの格式は指定格式を満足しない」というメールを発送
                            Call SendFormatErrorMail(objMail, "<HTML><BODY><H2>答えメールの格式は指定した格式と満足しない.</H2>格式は:<H2>Question:</H2><H2>Reply:</H2><H2>このメールは自動返信ですから、返信しないください</H2>")
                        
    End If
                    
    Else
                        
    '件名は指定格式を満足しなければ
                        Call SendFormatErrorMail(objMail, "<HTML><BODY><H2>件名は指定した格式と満足しない.</H2><H2>格式は:「件名;ユーザのメールアドレス」。</H2><H2>このメールは自動返信ですから、返信しないください.</H2>")
                    
    End If

                
    Else
                    
    '外部アドレス場合、DFサポート者へ転送
                    Call SendToDF(objMail)
                
    End If
            intBegin 
    = intEnd + 1
            intEnd 
    = InStr(intBegin, EntryIDCollection, ",")
        
    Loop
    End Sub

    '答えメールの件名から新しい件名と対応ユーザのメールアドレスを取得
    Private Function GetSubjectAndUser(subjectstr As StringAs Boolean
        
    Dim intPos As Integer
        intPos 
    = InStr(1, subjectstr, ";")
        
    If intPos <> 0 Then
            
    '件名に「;」前の文字列は新しい件名
            strSubject = Mid(subjectstr, 1, intPos - 1)
            
    '件名に「;」後の文字列は対応ユーザのアドレス
            strUser = Mid(subjectstr, intPos + 1)
            
    'アドレスが有効かどうかを判断
            If InStr(1, strUser, "@"<> 0 Then
                GetSubjectAndUser 
    = True
                
    Exit Function
            
    End If
        
    End If
        GetSubjectAndUser 
    = False
        
    Exit Function
    End Function

    '答えメールの内容から問題と答えを取得
    Private Function GetAnswerAndReply(bodystr As StringAs Boolean
        GetAnswerAndReply 
    = True
        
    Exit Function
    End Function


    Private Sub SendToDF(objMail)
        
    'DFMailListからDFサポート者のメールアドレスを取得して、メールを転送する
        Dim intPos As Integer
        
    Dim oldPos As Integer
        
    Dim NewMailItem As Outlook.MailItem
        intPos 
    = InStr(1, DFMailList, ";")
        
    Do While intPos <> 0
            strUser 
    = Mid(DFMailList, oldPos + 1, intPos - 1 - oldPos)
            
    Set NewMailItem = Application.CreateItem(olMailItem)
            
    With NewMailItem
                .Body 
    = objMail.Body
                .Subject 
    = objMail.Subject + ";" + objMail.SenderEmailAddress
            
    End With
            NewMailItem.Recipients.Add (strUser)
            NewMailItem.Send
            oldPos 
    = intPos
            intPos 
    = InStr(intPos + 1, DFMailList, ";")
        
    Loop
        strUser 
    = Mid(DFMailList, oldPos + 1)
        
    Set NewMailItem = Application.CreateItem(olMailItem)
        
    With NewMailItem
            .Body 
    = objMail.Body
            .Subject 
    = objMail.Subject + ";" + objMail.SenderEmailAddress
        
    End With
        NewMailItem.Recipients.Add (strUser)
        NewMailItem.Send
        
    'ログファイルに書く込む
        Open LogPath + "Logs.txt" For Append As #1
        
    Print #1"[" + Format(Now, "yyyy-mm-dd hh:mm:ss"+ "]から" + objMail.SenderEmailAddress + "受信メール " + objMail.Subject + " という件はDFサポート者へ転送している!"
        Close #
    1
    End Sub


    Private Sub SendFormatErrorMail(objMail, str)
        
    Dim NewMailItem As Outlook.MailItem
        
    Set NewMailItem = Application.CreateItem(olMailItem)
        
    With NewMailItem
            .BodyFormat 
    = olFormatHTML
            .HTMLBody 
    = str
            .Subject 
    = objMail.Subject
        
    End With
        NewMailItem.Recipients.Add (objMail.SenderEmailAddress)
        NewMailItem.Send
        Open LogPath 
    + "Logs.txt" For Append As #1
        
    Print #1"[" + Format(Now, "yyyy-mm-dd hh:mm:ss"+ "]から" + objMail.SenderEmailAddress + "受信メール " + objMail.Subject + " という件はstr!"
        Close #
    1
    End Sub

     
    展开全文
  • OutLookVBA

    2007-05-07 03:50:17
    做OFFICE二次开发的参考资料,OutLookVBA,这是office 2000的,新版Office只是增加了部分新功能,原理是相通的。
  • 系统:Windows 10 软件:Outlook 2016 本系列讲讲在Outlook中使用VBA实现一些...Office的Outlook本身也是支持VBA的二次开发,所以一起来看看 Part 2:环境介绍 和Excel中打开开发环境类似。文件-选项-自定义功能区
  • Office编程百宝箱29.0,简称VBA百宝箱。为Office编程国产首款超大型插件,原创30多个功能宝贝。所有功能通用于Excel、Word、PowerPoint、Outlook、Access、Publisher、Project、Office全家福。适用于微软Office2003...
  • Excel VBA开发自动发送邮件

    万次阅读 多人点赞 2017-04-27 17:37:33
    若没有做如下操作设置,则Excel VBA调用Outlook自动发送邮件时提示如下 2.1 Outlook->工具->信任中心 2.2 编程访问->选中”从不向我发出可疑活动警告(不推荐)“,注意:建议使用Excel VBA自动发送...
  • Outlook2010 VBA添加联系人

    千次阅读 2014-11-29 19:59:15
    最近突然想学习VBA,是因为发邮件时没有存联系人,只显示的是Email地址,有时没办法区分是谁,所以想把公司的所有人的Email和名称都添加进来。但是,公司人那么多,不可能一个一个的输入吧,那是肯定了,作为一个IT...
  • Office VBA官方开发文档全集,VBA开发必备,包含Office2013版所有套件(Access、Excel、Word、Powerpoint、Visio、Outlook、OneNote、Publisher、Office Shared)的全部可编程对象的详细说明
  • 利用VBA开发数据汇总工具通常在日常工作中总会用到Excel并且经常会遇到Excel将多个表格进行汇总。经过工作中的实践,发现用VBA开发具有一定重复性的功能,能够极大提高工作效率。最近,将本人曾开发的的Excel数据...
  • 通过VBA自定义outlook日历

    千次阅读 2018-09-17 11:21:20
    outlook日历功能很强大,设置了账号后,能在手机端进行同步...于是,从网上找了一段vba代码,能通过脚本自己设定日历。比如,9月2号开学,设定每周是第几教学周,具体代码如下: Sub SetAppt() Dim olApp As O...
  • vba for excel/word/outlook

    2009-12-19 11:23:41
    excel,word,outlook开发sdk
  • 适用于outlook的宏开发和基于COM的Add-in
  • Office 2010 中的 VBA 开发入门

    千次阅读 2013-07-27 17:42:53
    Office 2010 中的 VBA 开发入门 Office 2010 5(共 7)对本文的评价是有帮助 - 评价此主题 摘要:了解非编程人员如何使用 VBA 编程扩展 Microsoft Office 2010。内容包括
  • 如果你公司的邮件系统是Microsoft Exchange Server + Outlook,能在Outlook中执行VBA邮件规则,自动化处理邮件,可以节省大把的时间。自Outlook 2016开始,运作VBA邮件规则需要费一番周折了,跟博主来看看如何做吧。

空空如也

空空如也

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

outlookvba开发