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

どこ：

  • すべての前VOP08011316314153US- URL の定数部分
  • VOP08011316314153US/- 製品 ID 変数 (数千あります)
  • enter.asp?z=AFE38DC1F69084D0B95648B21B8F1DC65E2D7E9A11A710590C60AA49390E2DC928- 各顧客に固有のアクセス キー (私は使用しません)

スクリプトが欲しい：

  1. PRODUCT_ID_VARIABLEOutlook 受信トレイ フォルダー内のすべてのメッセージを検索する
  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

マクロは、INBOX 内のすべてのメールに対して実行されます。時間がかかる場合があります

' 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 に答える