1

我们的防火墙用户发送消息请求解除对他们认为不应被阻止的某些网站的阻止。他们的消息主题字段包含此类网站 url。实际上，每条消息发送一个 url。由于用户数量的增加，预计每天会收到数百或可能数千条消息。

是否有一个 Outlook 宏可以将此类 url（从收到的邮件主题字段）收集或提取到一个文本文件中，而无需打开任何邮件？

非常感谢您对此事的任何帮助。

提前致谢

4

2 回答 2

3

请将此代码写入您的 Outlook VBA 模块。在下面的一些行中更改文件夹和目标文件的一些名称。有关其他信息，请参阅 sub 中的注释。

Sub Retrieve_http()

'our Outlook folder- deifinitions
    Dim myItem As MailItem
    Dim myFolder As Folder
    Dim myNamespace As NameSpace
    Set myNamespace = Application.GetNamespace("MAPI")
    'put your folders name here
    '1st one is store folder which should refer to firewall_support@iuass.org
    'second is possibly 'inbox folder'
    Set myFolder = myNamespace.folders("firewall_support@iuass.org").folders("inbox")

'destination file
    Dim resFile As String
        resFile = "c:\Users\Kazik\Desktop\httpRequest.txt"
    Dim ff As Byte
        ff = FreeFile()
    'creating or opening it- each time you run this macro we will append data
    'until deletion of either file or its content
    Open resFile For Append As #ff

    For Each myItem In myFolder.items
        If InStr(1, myItem.Subject, "http://") > 0 And _
            InStr(1, myItem.Subject, "classified under:") > 0 Then
                'write to file
                Write #ff, myItem.Subject

        End If
    Next
    Close #ff
End Sub

编辑以包括适当的删除过程和对图片的代码引用。

下图显示 Outlook 窗口（波兰语版），其中： Business Mail 是顶级文件夹之一（指单独的 .pst 文件）。“Skrzynka odbiorcza”只是“收件箱”。

在此处输入图像描述

搜索某些电子邮件、检索电子邮件主题并随后删除电子邮件的代码如下所示：

Sub Retrieve_http()

'our Outlook folder- deifinitions
    Dim myItem As MailItem
    Dim myFolder As Folder
    Dim myNamespace As NameSpace
    Set myNamespace = Application.GetNamespace("MAPI")
    'put your folders name here
    Set myFolder = myNamespace.folders("Business Mail").folders("skrzynka odbiorcza")

'destination file
    Dim resFile As String
        resFile = "c:\Users\Kazik\Desktop\httpRequest.txt"
    Dim ff As Byte
        ff = FreeFile()
    'creating or opening it- each time you run this macro we will append data
    'until deletion of either file or its content
    Open resFile For Append As #ff
    Dim i!
    For i = myFolder.items.Count To 1 Step -1
        If InStr(1, myFolder.items(i).Subject, "http://") > 0 And _
            InStr(1, myFolder.items(i).Subject, "classified under") > 0 Then
                'write to file
                Write #ff, myFolder.items(i).Subject
                'delete item
                myFolder.items(i).Delete
        End If
    Next
    Close #ff
End Sub
于 2013-04-26T05:53:37.567 回答
0

这是您问题的解决方案:)

当您制作 For Each Outlook 时，它会枚举每封电子邮件。如果您在 For Each 循环中移动任何电子邮件，则 Outlook 会更改文件夹中所有电子邮件的数量，但不会更改循环的迭代次数。这会导致一些消息将不会被读取。

解决方案是从最后一封电子邮件开始循环，如此处提到的 Outlook 宏，以从大量邮件的“主题字段”中收集/提取数据到文本文件中

代码：将（对于 Inbox.Items 中的每个 InboxMsg）替换为

For i = Inbox.Items.Count To 1 Step -1 '从末端向后迭代 Set InboxMsg = Inbox.Items(i)

于 2013-10-04T14:24:00.137 回答