[OL2K]VBA en automatisch attachments naar folder

[henkleerssen]

Ik probeer met Outlook attachments snel te saven (via een button) van de geselecteerde mails van mijn Inbox naar een vaste folder (en ze weer verwijdert uit de het orginele mailtje). Dit kan eigenlijk alleen maar met VBA. Dit lijkt weliswaar simpel.. maar niets is minder waar...
Met currentitem property van de activeinspector object kom je al een eind.. zoals ik hieronder heb gedaan...
dit werkt echter alleen nog maar voor 1 mail (currentitem) ... die ook nog geopend moet hebben...

Visual Basic:

Sub ExtractAttachements()
    
Dim myOlApp As Object
Dim myNameSpace As Object
Dim myItem As Object, myItem2 As Object
Dim a As Action
Dim MyAttachment ' As Long
Dim CountAttachements As Integer
Dim PathName As String
Dim Fullpathnames()
Dim iFullpathname As Integer
Dim iPathname As Integer

On Error GoTo ErrorHandler

'first look at outlook path settings
PathName = AttachmentPathname

'then look at the attachements
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myItem = myOlApp.ActiveInspector.CurrentItem
CountAttachements = myItem.Attachments.Count
If CountAttachements = 0 Then
    MsgBox "No attachements found.", vbInformation
    Exit Sub
End If

'save each attachement in AttachmentPathname folder
For Each MyAttachment In myItem.Attachments '= CountAttachements To 1 Step -1
    MyAttachment.SaveAsFile PathName & MyAttachment.DisplayName
    iFullpathname = iFullpathname + 1
    ReDim Preserve Fullpathnames(iFullpathname)
    Fullpathnames(UBound(Fullpathnames)) = PathName & MyAttachment.DisplayName
    MyAttachment.Delete 'myItem.Attachments.Delete
Next

btw.. niet de hele code staat hier van de sub.. maar dat doet er ook niet toe...

Maar nou wil ik dus het een ander doen met geselecteerde mails (dus niet dat ik ze dus een moet openen om attachments te saven)...
Wie o wie heeft de oplossing..
Ooh ja.. kom niet met adviezen van "Ooh dat moet je ff zoeken op vbcode.com, of gewoon googlen" want je vindt het gewoon niet... (tenminste .. ik ben er lang op zoek naar geweest)..

Iemand die het toch denkt te weten?

[henkleerssen]

Niemand?

[bas.kb]

Dit onderstaande script doet alles wat jij wilt, behalve het verwijderen van de attachment uit het mailtje. Als je ze selecteerd en de macro aanroept voert ie netjes alles uit.

<code>
Sub opslaan()
'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection

'Ask for destination folder
myOrt = "C:\test\"

On Error Resume Next

'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'for all items do...
For Each myItem In myOlSel

'point on attachments
Set myAttachments = myItem.Attachments

'if there are some...
If myAttachments.Count > 0 Then

'for all attachments do...
For i = 1 To myAttachments.Count

'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName

Next i

End If

Next

'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
End Sub
</code>

Ik zocht zelf naar een oplossing, en liep tegen jou berichtje aan. In de tussentijd heb ik het gevonden, dus post ik het hier nog maar effekes.

[henkleerssen]

IK had ondertussen ook de oplossing gevonden, maar toch altijd goed om van andere alternatieven te horen. thanks!

offtopic:
code kun je het beste zo aangeven met [ code = vb] (zonder spaties)