[VBA/Outlook] Saven van attachment in outlook folder

[Anakin239]

Via de onderstaande code probeer ik de attachment van een mailtje in een bepaalde outlook folder op te slaan. Alleen krijg ik dit niet voor elkaar. Ik weet dat alle attachments ook weer mailtjes zijn. Dus die zouden met gemak in de outlook folder opgeslagen moeten kunnen worden.

Kan iemand mij uit de brand helpen.

code:

Sub extract()
    Dim oApp As Application
    Dim oNS As NameSpace
    Dim oMsg As Object
    Dim oAttachments As Outlook.Attachments
    Dim oAttachment As Object
    Dim oNewMail As MailItem
    
    Dim oMailItem As MailItem
    Dim oObject As Object

    Dim oSubAttachment As Object
    Dim oItem As Items                'use as subattachment in this
    Dim strControl
 
    
            
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
    Set myFolder = oFolder.Folders("Test")
    Set myFolderTooDeep = myFolder.Folders("Test too deep")
    Set myFolderDone = myFolder.Folders("Test done")
    Set myFolderNoAtt = myFolder.Folders("Test attachment")
    
    
    strControl = 0
    
    For Each oMsg In myFolder.Items        'oMsg is an item
        With oMsg               'oMsg has attachments or  attachmet
           Debug.Print oMsg.Attachments.Count
          If (oMsg.Attachments.Count > 0) Then
          
            
             For Each oAttachment In oMsg.Attachments
                                   'an attachments or an attachment
                 
                With oAttachment
                    
                mytype = oAttachment.Type
                    
                    toodeep = 0
                    
                    If (mytype = 1) Then
                               'a file with a name
                        strControl = strControl + 1
                        oAttachment.SaveAsFile _
                        "c:\" _
                        & strControl & oAttachment.FileName
                     
                    
                     
                    ElseIf (mytype = 5) Then

                        'Hier moet het mailtje in een andere folder gesaved worden. 
                        
                        Set oNewMail = oAttachment
                        oNewMail.Move myFolderTooDeep
                        
                       
                    End If
                    
                End With
        
            Next
            
            If toodeep = 0 Then
            oMsg.Move myFolderDone
                'saved all attachments - move this mail to done
            End If
          
          Else
            oMsg.Move myFolderNoAtt
          
          End If
        End With
        
    
    Next

End Sub

[gorgi_19]

Definieer eens: "Ik krijg het niet voor elkaar"

Wat doet het niet, wat moet het doen en welke foutmeldingen krijg je.

[Anakin239]

Ik krijg de attachment niet geconverteerd naar een mail message, error melding "type mismatch" (zo is het code voorbeeld).
en/of ik kan de attachment niet saven in een outlook folder, alleen als file.

[gorgi_19]

Anakin239 schreef op 04 August 2003 @ 20:34:
Ik krijg de attachment niet geconverteerd naar een mail message, error melding "type mismatch" (zo is het code voorbeeld).
en/of ik kan de attachment niet saven in een outlook folder, alleen als file.

En kan je die regel ook nog aangeven in die lap code?

[justmental]

Leg eens uit waar de code iets anders doet dan je verwacht had, wat gaat wel goed, wat gaat niet goed?
P&W FAQ - De "quickstart"

[Anakin239]

Dit is de regel waarop de code knalt

code:

Set oNewMail = oAttachment

[Verwijderd]

Ik weet dat alle attachments ook weer mailtjes zijn

Sinds wanneer?

Een attachment is niet zomaar een mailtje. Ik denk dat je iets onmogelijks probeert te doen. Ook omdat de foutmelding al aangeeft dat je van een attachment helemaal geen bericht kunt maken.

[DukeMan]

Anakin239 schreef op 04 August 2003 @ 20:29:

code:

Sub extract()

...

    For Each oMsg In myFolder.Items        'oMsg is an item
        With oMsg               'oMsg has attachments or  attachmet
           Debug.Print oMsg.Attachments.Count
          If (oMsg.Attachments.Count > 0) Then
          
            
             For Each oAttachment In oMsg.Attachments
                                   'an attachments or an attachment
                 
                With oAttachment
                    
                mytype = oAttachment.Type
                    ...
End Sub

offtopic:
Je gebruikt
With oMsg
maar de regel erna doe je
If (oMsg.Attachments.Count > 0) Then

een With block gebruik je om het object niet steeds te herhalen.... dus niet zoals jij het hebt, maar
With oMsg 'oMsg has attachments or attachmet
Debug.Print .Attachments.Count
If (.Attachments.Count > 0) Then

Je kan ook geen geneste With blocks krijgen zoals je nu gedaan hebt, met eerst het bericht en dan het attachment... (oMsg, oAttachment )

Verwijderd schreef op 05 August 2003 @ 10:12:
[...]




Sinds wanneer?

Een attachment is niet zomaar een mailtje. Ik denk dat je iets onmogelijks probeert te doen. Ook omdat de foutmelding al aangeeft dat je van een attachment helemaal geen bericht kunt maken.

Ik denk dat hij een bepaalde folder heeft waar alleen maar emails in staan met een ander mailtje als attachment....

[ Voor 2% gewijzigd door DukeMan op 05-08-2003 13:02 . Reden: typo ]

[Anakin239]

LS,

Het is inmiddels gelukt. Iedereen bedankt voor het meedenken.
Met deze code:

code:

Sub extract()
    Dim oApp As Application
    Dim oNS As NameSpace
    Dim oMsg As Object
    Dim oAttachments As Outlook.Attachments
    Dim oAttachment As Object
    Dim oNewMail As MailItem
    Dim oMailItem As MailItem
    Dim oObject As Object
    Dim oSubAttachment As Object
    Dim oItem As Items                'use as subattachment in this
    Dim strControl
    Dim strBody As String
    Dim oFSO

    
    

    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
    Set myfolder = oFolder.Folders("Cap Gemini")
    Set myFolderStart = myfolder.Folders("JW")
    Set myFolderDone = myfolder.Folders("Done")
    Set myfoldernoatt = myfolder
    
    
    strControl = 0
    
    For Each oMsg In myFolderStart.Items         'oMsg is an item
        With oMsg               'oMsg has attachments or  attachmet
          If (.Attachments.Count > 0) Then
             For Each oAttachment In .Attachments
               'an attachments or an attachment
                With oAttachment
                    mytype = .Type
                    If (mytype = 5) Then
                        'Set oNewMail = oAttachment
                        .SaveAsFile "c:\Test.msg"
                        'Create item from template
                        Set oNewMail = oApp.CreateItemFromTemplate("c:\test.msg", myfolder)
                        'Copy the body or you lose it
                        strBody = oNewMail.Body
                        'Create a new instance
                        Set oNewMail = oNewMail.Copy
                        'Reset the body
                        oNewMail.Body = strBody
                        'Move the new mail
                        oNewMail.Move myfolder
                        'Delete the temp file
                        oFSO.DeleteFile "c:\test.msg"
                    End If
                End With
            Next
            
            .Move myFolderDone
          End If
        End With
        
    
    Next

End Sub

[curry684]

offtopic:
Cheerios voor het posten v/d oplossing