Verzonden bijlages opslaan

[goedlichtJoost]

Beste allemaal,

Ik zou graag iets vinden waardoor ik in 1 keer alle bijlages uit al mijn verzonden mail kan opslaan.
Ik heb al een macro gevonden voor alle bijlages in mijn postvakIN en deze werkt perfect.

Is deze aan te passen voor verzonden items ?(hoe?) Of weet er iemand eenzelfde methode?

Alle hulp is welkom,

Met vriendelijke groeten

Joost

Hier de macro voor postvakIN

Sub GetAttachments()
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.
    On Error GoTo GetAttachments_err
' Declare variables
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0
' Check Inbox for messages and exit of none found
    If Inbox.Items.Count = 0 Then
        MsgBox "There are no messages in the Inbox.", vbInformation, _
               "Nothing Found"
        Exit Sub
    End If
' Check each message for attachments
    For Each Item In Inbox.Items
' Save any attachments found
        For Each Atmt In Item.Attachments
        ' This path must exist! Change folder name as necessary.
            FileName = "D:\Email Bijlage\" & Atmt.FileName
            Atmt.SaveAsFile FileName
            i = i + 1
         Next Atmt
    Next Item
' Show summary message
    If i > 0 Then
        MsgBox "I found " & i & " attached files." _
        & vbCrLf & "I have saved them into the C:\Email Attachments folder." _
        & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
    Else
        MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
' Clear memory
GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
' Handle errors
GetAttachments_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume GetAttachments_exit
End Sub

 

[edmoor]

Wellicht olFolderInbox wijzigen in olFolderOutbox?
En dan voor de duidelijkheid ook de variabele Inbox wijzigen in Outbox.

 

[goedlichtJoost]

Beste Edmoor,

helaas, heb ik ook al geprobeerd, geen resultaat.
olFolderOutbox, zal wellicht postvakuit zijn. Deze is natuurlijk leeg.
olFolderSentMail ook geprobeerd.
mvg

 

[edmoor]

Ik heb hem aangepast zoals ik zei en dat werkt prima. Uiteraard wel met olFolderSentMail

Sub GetAttachments()
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.
    On Error GoTo GetAttachments_err
' Declare variables
    Dim ns As NameSpace
    Dim SDbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")
    Set SDbox = ns.GetDefaultFolder(olFolderSentMail)
    i = 0
' Check Sent mailbox for messages and exit of none found
    If SDbox.Items.Count = 0 Then
        MsgBox "There are no messages in the Sent mailbox.", vbInformation, _
               "Nothing Found"
        Exit Sub
    End If
' Check each message for attachments
    For Each Item In SDbox.Items
' Save any attachments found
        For Each Atmt In Item.Attachments
        ' This path must exist! Change folder name as necessary.
            FileName = "D:\Email Bijlage\" & Atmt.FileName
            Atmt.SaveAsFile FileName
            i = i + 1
         Next Atmt
    Next Item
' Show summary message
    If i > 0 Then
        MsgBox "I found " & i & " attached files." _
        & vbCrLf & "I have saved them into the D:\Email Bijlage folder." _
        & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
    Else
        MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
' Clear memory
GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
' Handle errors
GetAttachments_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume GetAttachments_exit
End Sub

 

[goedlichtJoost]

@ Edmoor,

Ik krijg deze error:

An unexpected error has occurred.
Please note and report the following information.
Macro Name: Get Attachments
Error Number:-1283440635
Error Description: Kan de actie niet uitvoeren op dit type bijlage.

 

[edmoor]

En weet je ook om welk bericht en wat voor een bijlage het gaat? De code is goed dus daar zul je achter moeten zien te komen in debug mode.