0

在 Outlook 2010 中，我为多个客户提供了数千个电子邮件产品更新，邮件正文中的 URL 如下所示：

http://shop.khlynov.net/products/en/PRODUCT_ID_VARIABLE/enter.asp?z=UNIQUE_ACCESS_KEY

类似的东西：

http://shop.khlynov.net/products/en/VOP08011316314153US/enter.asp?z=AFE38DC1F69084D0B95648B21B8F1DC65E2D7E9A11A710590C60AA49390E2DC928

在哪里：

  • all before VOP08011316314153US- URL 的常量部分
  • VOP08011316314153US/- 产品 ID 变量（有数千个）
  • enter.asp?z=AFE38DC1F69084D0B95648B21B8F1DC65E2D7E9A11A710590C60AA49390E2DC928- 每个客户唯一的访问密钥（我不使用它）

我想要一个脚本：

  1. PRODUCT_ID_VARIABLE在 Outlook 收件箱文件夹中的所有邮件中搜索
  2. 创建根据PRODUCT_ID_VARIABLE（如果不存在）命名的子文件夹
  3. 将具有不同 PRODUCT_ID_VARIABLE 的消息移动到相应的子文件夹中。

在下面的示例中，脚本应该创建文件夹VOP08011316314153US和VOP08011316314154US（如果它们不存在）并将所有带有产品 IDVOP08011316314153US和VOP08011316314154USURL 的消息移到那里：

以下是电子邮件正文的示例：

<table align="left">
    <tr>
        <td style="padding: 9px;" align="left">
            <p style="font-size: 10px; font-family: 'Trebuchet MS', Arial, Helvetica, sans-serif;
                            color: #333333;">
               <span style="color: #9B0124;">PRODUCT LINK: </span><br />
                  <a href="http://shop.khlynov.net/products/en/VOP23011304005259US/enter.asp?z=ABCC226C7CBA08F2D0CE2BAB7CBFE493E04D9533489C3FF245EB4061D0FA6A7D18" target="_blank" style="text-decoration: none; color: #333333;">http:/<wbr>/<wbr>shop.khlynov.net/<wbr>products/<wbr>en/<wbr>VOP23011304005259US/<wbr>enter.asp?z=ABCC226C7CBA08F2D0CE2BAB7CBFE493E04D9533489C3FF245EB4061D0FA6A7D18</a>
           </p>
       </td>
   </tr>
</table>


INBOX
-VOP08011316314153US
-- Email 1
-- Email 2
-- Email ...
-- Email X
-VOP08011316314154US
-- Email 1
-- Email 2
-- Email ...
-- Email X

我是 VBA 编码的新手。任何人都可以帮助从头开始编写代码吗？

我刚刚发现您的宏适用于纯文本，但不适用于 HTML 字母。这是HTML代码的一部分：

<table align="left">
                <tr>
                    <td style="padding: 9px;" align="left">
                        <p style="font-size: 10px; font-family: 'Trebuchet MS', Arial, Helvetica, sans-serif;
                            color: #333333;">
                            <span style="color: #9B0124;">PRODUCT LINK: </span>
                            <br />
                            <a href="http://shop.khlynov.net/products/en/VOP23011304005259US/enter.asp?z=ABCC226C7CBA08F2D0CE2BAB7CBFE493E04D9533489C3FF245EB4061D0FA6A7D18" target="_blank" style="text-decoration: none; color: #333333;">http:/<wbr>/<wbr>shop.khlynov.net/<wbr>products/<wbr>en/<wbr>VOP23011304005259US/<wbr>enter.asp?z=ABCC226C7CBA08F2D0CE2BAB7CBFE493E04D9533489C3FF245EB4061D0FA6A7D18</a>
                        </p>
                    </td>
                </tr>
            </table>
4

1 回答 1

1

宏将针对收件箱中的所有邮件运行 .. 可能需要一些时间

' run this macro
Sub main_procedure()
    On Error GoTo eh:
    Dim ns As Outlook.NameSpace
    Dim folder As MAPIFolder
    Dim item As Object
    Dim msg As MailItem

    Set ns = Session.Application.GetNamespace("MAPI")
    Set folder = ns.GetDefaultFolder(olFolderInbox)
    MsgBox "Total Number of mail in your inbox " & folder.Items.Count
    For Each item In folder.Items

        If (item.Class = olMail) Then
            Set msg = item
            If InStr(msg.Body, "http://shop.khlynov.net/products/en/") > 0 Then
                URL = msg.Body
                createAndMoveMail URL, msg

            ElseIf InStr(msg.Subject, "http://shop.khlynov.net/products/en/") > 0 Then
                URL = msg.Subject
                createAndMoveMail URL, msg
            End If
        End If
    Next


    Exit Sub
eh:
    MsgBox Err.Description, vbCritical, Err.Number
End Sub



Sub createAndMoveMail(ByVal URL As String, ByRef mail As MailItem)
Dim productID As String
Dim URLPath As String
Dim folderExist As Boolean
Dim startIndex As Long
Dim found As Boolean
On Error goto 0
found = False

Do While Not found
    productID = ""
    startIndex = InStr(URL, "http://shop.khlynov.net/products/en/")
    If startIndex = 0 Then
        Exit Sub
    End If
    URLPath = Mid(URL, startIndex)
    URLPath = Mid(URLPath, Len("http://shop.khlynov.net/products/en/") + 1)
    'update new url
    URL = URLPath
    If InStr(ULRPath, "/") = 0 Then
        Exit Sub
    End If
    productID = Mid(URLPath, 1, InStr(URLPath, "/") - 1)
    If Len(productID) = 19 And InStr(productID, "VOP") > 0 And InStr(productID, "US") > 0 Then
        found = True
        Exit Do
    End If
Loop



If Not found Then
    Exit Sub
End If





Dim myInbox As Outlook.MAPIFolder
Set myInbox = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

folderExist = False
For i = 1 To myInbox.Folders.Count
    If myInbox.Folders.item(i).Name = productID Then
        folderExist = True
        Set myDestinationFolder = myInbox.Folders.item(i)
        Exit For
    End If
Next
If Not folderExist Then
    Set myDestinationFolder = myInbox.Folders.Add(productID, olFolderInbox)
End If

mail.Move myDestinationFolder
End Sub

参考： 阅读收件箱邮件项 创建邮件文件夹，移动邮件项

于 2013-01-23T10:20:05.873 回答