0

これは紛らわしいかもしれませんが、これで終わりです。

現在、タイトル/日付「XXX 20130624」の Outlook 検索を開いて、指定した名前のドライブにある「テンプレート ファイル」に保存する必要があります。つまり、Outlook の添付ファイルの件名は「ABC 20130624」で、添付の Excel ファイルには「ZBA Extra」というラベルが付けられています。次に、添付ファイルを「ABC」としてネットワークに保存します。

どんな助けでも大歓迎です。

4

2 に答える 2

1

ここでは、何をする必要があるかを段階的に説明します。コードは、そのままでは機能しない半疑似コードです。不明な点はすべて質問してください。

1.0 Outlook の実行中のインスタンスをオブジェクトに取得する

outlook = GetObject( , "Outlook.Application" )

2.0 次に、受信トレイ (olFolderInbox = 6) フォルダーにアクセスします。これは Namespace オブジェクトを介して行う必要があります

namespace = outlook.GetNameSpace("MAPI")
inboxFolder = namespace.GetDefaultFolder(olFolderInbox)

3.0 このフォルダ内で、必要なドキュメントを検索します。あなたの要件は特にあいまいです。ハードコードされた日付で終わる件名は問題ないと思います。ここでは、DASL 構文を使用してlike演算子を実行しています。

filter = ""@SQL=""http://schemas.microsoft.com/mapi/proptag/0x0037001f"" = ' 20130628'
items = inboxFolder.Items.Restrict( filter )

4.0 遭遇した項目を列挙します。

For Each item in items
...
Next item

4.1. 各アイテムについて、件名を保存し、最初のスペースから何かを取り除きます

subject = mailItem.Subject
spaceIndex = InStr( subject, " " )
extractFilename = Left( subject, spaceIndex )

4.2 添付ファイルを列挙し、名前を付けて保存します。

For Each attachment In Item.Attachments
   fileName = "H:\" & exdtractedFilename & ".xlsx"
   attachment.SaveAsFile fileName
Next attachment

複数の添付ファイルがある場合、これにより同じファイルが複数回上書きされることに注意してください。その状況に対処する方法を考えたいと思うかもしれません。

于 2013-06-28T12:28:12.410 に答える
0 
    Public Sub Extract_Outlook_Email_Attachments()

    Dim OutlookOpened As Boolean
    Dim outApp As Outlook.Application
    Dim outNs As Outlook.Namespace
    Dim outFolder As Outlook.MAPIFolder
    Dim outAttachment As Outlook.Attachment
    Dim outItem As Object
    Dim saveFolder As String
    Dim outMailItem As Outlook.MailItem
    Dim inputDate As String, subjectFilter As String


    saveFolder = "Y:\Wingman" ' THIS IS WHERE YOU WANT TO SAVE THE ATTACHMENT TO

    If Right(saveFolder, 1) <> "\" Then saveFolder = saveFolder & "\"

    subjectFilter = ("Daily Operations Custom All Req Statuses Report") ' THIS IS WHERE YOU PLACE THE EMAIL SUBJECT FOR THE CODE TO FIND

    OutlookOpened = False
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set outApp = New Outlook.Application
        OutlookOpened = True
    End If
    On Error GoTo 0

    If outApp Is Nothing Then
        MsgBox "Cannot start Outlook.", vbExclamation
        Exit Sub
    End If

    Set outNs = outApp.GetNamespace("MAPI")
    Set outFolder = outNs.GetDefaultFolder(olFolderInbox)

    If Not outFolder Is Nothing Then
        For Each outItem In outFolder.Items
            If outItem.Class = Outlook.OlObjectClass.olMail Then
                Set outMailItem = outItem
                    If InStr(1, outMailItem.Subject, "subjectFilter") > 0 Then
                        For Each outAttachment In outMailItem.Attachments
                        outAttachment.SaveAsFile saveFolder & outAttachment.filename

                        Set outAttachment = Nothing

                        Next
                    End If
            End If
        Next
    End If

    If OutlookOpened Then outApp.Quit

    Set outApp = Nothing

    End Sub
于 2016-07-25T14:52:01.893 に答える